home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / gnu / emacs.lha / emacs-19.16 / lisp / allout.el < prev    next >
Lisp/Scheme  |  1993-06-09  |  112KB  |  2,615 lines

  1. ;;;_* Allout - An extensive outline-mode for Emacs.
  2. ;;; Note - the lines beginning with ';;;_' are outline topic headers.
  3. ;;;        Load this file (or 'eval-current-buffer') and revisit the
  4. ;;;        file to give it a whirl.
  5.  
  6. ;;;_ + Provide
  7. (provide 'outline)
  8.  
  9. ;;;_ + Package Identification Stuff
  10.  
  11. ;;;_  - Author: Ken Manheimer <klm@nist.gov>
  12. ;;;_  - Maintainer: Ken Manheimer <klm@nist.gov>
  13. ;;;_  - Created: Dec 1991 - first release to usenet
  14. ;;;_  - Version: $Id: allout.el,v 1.3 1993/06/09 11:51:08 jimb Exp $||
  15. ;;;_  - Keywords: outline mode
  16.  
  17. ;;;_  - LCD Archive Entry
  18.  
  19. ;; LCD Archive Entry:
  20. ;; allout|Ken Manheimer|klm@nist.gov
  21. ;; |A more thorough outline-mode
  22. ;; |27-May-1993|$Id: allout.el,v 1.3 1993/06/09 11:51:08 jimb Exp $||
  23.  
  24. ;;;_  - Description
  25. ;; A full-fledged outline mode, based on the original rudimentary
  26. ;; GNU emacs outline functionality.
  27. ;;
  28. ;; Ken Manheimer             Nat'l Inst of Standards and Technology
  29. ;; klm@nist.gov (301)975-3539            (Formerly Nat'l Bureau of Standards)
  30. ;;    NIST Shared File Service Manager and Developer
  31.  
  32. ;;;_  - Copyright
  33. ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
  34.  
  35. ;; This file is part of GNU Emacs.
  36.  
  37. ;; GNU Emacs is distributed in the hope that it will be useful,
  38. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  39. ;; accepts responsibility to anyone for the consequences of using it
  40. ;; or for whether it serves any particular purpose or works at all,
  41. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  42. ;; License for full details.
  43.  
  44. ;; Everyone is granted permission to copy, modify and redistribute
  45. ;; GNU Emacs, but only under the conditions described in the
  46. ;; GNU Emacs General Public License.   A copy of this license is
  47. ;; supposed to have been given to you along with GNU Emacs so you
  48. ;; can know your rights and responsibilities.  It should be in a
  49. ;; file named COPYING.  Among other things, the copyright notice
  50. ;; and this notice must be preserved on all copies.
  51.  
  52. ;;;_ + User Customization variables
  53.  
  54. ;;;_  - Topic Header configuration
  55.  
  56. ;;;_   = outline-header-prefix
  57. (defvar outline-header-prefix "."
  58.   "*   Leading string for greater than level 0 topic headers.")
  59. (make-variable-buffer-local 'outline-header-prefix)
  60.  
  61. ;;;_   = outline-header-subtraction
  62. (defvar outline-header-subtraction (1- (length outline-header-prefix))
  63.   "*   Leading string for greater than level 0 topic headers.")
  64. (make-variable-buffer-local 'outline-header-subtraction)
  65.  
  66. ;;;_   = outline-primary-bullet
  67. (defvar outline-primary-bullet "*") ;; Changing this var disables any
  68.                                     ;; backwards compatibility with
  69.                                     ;; the original outline mode.
  70. (make-variable-buffer-local 'outline-primary-bullet)
  71.  
  72. ;;;_   = outline-plain-bullets-string
  73. (defvar outline-plain-bullets-string ""
  74.   "*   The bullets normally used in outline topic prefixes.  See
  75.    'outline-distinctive-bullets-string' for the other kind of
  76.    bullets.
  77.  
  78.    DO NOT include the close-square-bracket, ']', among any bullets.
  79.  
  80.    You must run 'set-outline-regexp' in order for changes to the
  81.    value of this var to effect outline-mode operation.")
  82. (setq outline-plain-bullets-string (concat outline-primary-bullet
  83.                                            "+-:.;,"))
  84. (make-variable-buffer-local 'outline-plain-bullets-string)
  85.  
  86. ;;;_   = outline-distinctive-bullets-string
  87. (defvar outline-distinctive-bullets-string ""
  88.   "*   The bullets used for distinguishing outline topics.  These
  89.    bullets are not offered among the regular rotation, and are not
  90.    changed when automatically rebulleting, as when shifting the
  91.    level of a topic.  See 'outline-plain-bullets-string' for the
  92.    other kind of bullets.
  93.  
  94.    DO NOT include the close-square-bracket, ']', among any bullets.
  95.  
  96.    You must run 'set-outline-regexp' in order for changes
  97.    to the value of this var to effect outline-mode operation.")
  98. (setq outline-distinctive-bullets-string "=>([{}&!?#%\"X@$~")
  99. (make-variable-buffer-local 'outline-distinctive-bullets-string)
  100.  
  101. ;;;_   > outline-numbered-bullet ()
  102. (defvar outline-numbered-bullet ()
  103.   "*   Bullet signifying outline prefixes which are to be numbered.
  104.    Leave it nil if you don't want any numbering, or set it to a
  105.    string with the bullet you want to be used.")
  106. (setq outline-numbered-bullet "#")
  107. (make-variable-buffer-local 'outline-numbered-bullet)
  108.  
  109. ;;;_   = outline-file-xref-bullet
  110. (defvar outline-file-xref-bullet "@"
  111.   "*  Set this var to the bullet you want to use for file cross-references.
  112.    Set it 'nil' if you want to inhibit this capability.")
  113.  
  114. ;;;_  - Miscellaneous customization
  115.  
  116. ;;;_   = outline-stylish-prefixes
  117. (defvar outline-stylish-prefixes t
  118.   "*A true value for this var makes the topic-prefix creation and modification
  119.    functions vary the prefix bullet char according to level.  Otherwise, only
  120.    asterisks ('*') and distinctive bullets are used.
  121.  
  122.    This is how an outline can look with stylish prefixes:
  123.  
  124.    * Top level
  125.    .* A topic
  126.    . + One level 3 subtopic
  127.    .  . One level 4 subtopic
  128.    . + Another level 3 subtopic
  129.    .  . A level 4 subtopic
  130.    .  #2 A distinguished, numbered level 4 subtopic
  131.    .  ! A distinguished ('!') level 4 subtopic
  132.    .  #4 Another numbered level 4 subtopic
  133.    
  134.    This would be an outline with stylish prefixes inhibited:
  135.  
  136.    * Top level
  137.    .* A topic
  138.    .! A distinctive (but measly) subtopic
  139.    . * A sub-subtopic - no bullets from outline-plain-bullets-string but '*'
  140.  
  141.    Stylish and constant prefixes (as well as old-style prefixes) are
  142.    always respected by the topic maneuvering functions, regardless of
  143.    this variable setting.
  144.  
  145.    The setting of this var is not relevant when outline-old-style-prefixes
  146.    is t.")
  147. (make-variable-buffer-local 'outline-stylish-prefixes)
  148.  
  149. ;;;_   = outline-old-style-prefixes
  150. (defvar outline-old-style-prefixes nil
  151.   "*Setting this var causes the topic-prefix creation and modification
  152.    functions to make only asterix-padded prefixes, so they look exactly
  153.    like the old style prefixes.
  154.  
  155.    Both old and new style prefixes are always respected by the topic
  156.    maneuvering functions.")
  157. (make-variable-buffer-local 'outline-old-style-prefixes)
  158.  
  159. ;;;_   = outline-enwrap-isearch-mode
  160.                                         ; Spiffy dynamic-exposure
  161.                                         ; during searches requires
  162.                                         ; Dan LaLiberte's isearch-mode:
  163. (defvar outline-enwrap-isearch-mode "isearch-mode.el"
  164.   "*  Set this var to the name of the (non-compiled) elisp code for
  165.    isearch-mode, if you have Dan LaLiberte's 'isearch-mode'
  166.    stuff and want isearches to reveal hidden stuff encountered in the
  167.    course of a search, and reconceal it if you go past.  Set it nil if
  168.    you don't have the package, or don't want to use this feature.")
  169.  
  170. ;;;_   = outline-use-hanging-indents
  171. (defvar outline-use-hanging-indents t
  172.   "*  Set this var non-nil if you have Kyle E Jones' filladapt stuff,
  173.   and you want outline to fill topics as hanging indents to the
  174.   bullets.")
  175. (make-variable-buffer-local 'outline-use-hanging-indents)
  176.  
  177. ;;;_   = outline-reindent-bodies
  178. (defvar outline-reindent-bodies t
  179.   "*  Set this var non-nil if you want topic depth adjustments to
  180.   reindent hanging bodies (ie, bodies lines indented to beginning of
  181.   heading text).  The performance hit is small.
  182.  
  183.   Avoid this strenuously when using outline mode on program code.
  184.   It's great for text, though.")
  185. (make-variable-buffer-local 'outline-reindent-bodies)
  186.  
  187. ;;;_   = outline-mode-keys
  188. ;;; You have to restart outline-mode - '(outline-mode t)' - to have
  189. ;;; any changes take hold.
  190. (defvar outline-mode-keys ()
  191.   "Assoc list of outline-mode-keybindings, for common reference in setting 
  192. up major and minor-mode keybindings.")
  193. (setq outline-mode-keys
  194.       '(
  195.                                         ; Motion commands:
  196.         ("\C-c\C-n" outline-next-visible-heading)
  197.         ("\C-c\C-p" outline-previous-visible-heading)
  198.         ("\C-c\C-u" outline-up-current-level)
  199.         ("\C-c\C-f" outline-forward-current-level)
  200.         ("\C-c\C-b" outline-backward-current-level)
  201.         ("\C-c\C-a" outline-beginning-of-current-entry)
  202.         ("\C-c\C-e" outline-end-of-current-entry)
  203.                                         ; Exposure commands:
  204.         ("\C-c\C-i" outline-show-current-children)
  205.         ("\C-c\C-s" outline-show-current-subtree)
  206.         ("\C-c\C-h" outline-hide-current-subtree)
  207.         ("\C-c\C-o" outline-show-current-entry)
  208.         ("\C-c!" outline-show-all)
  209.                                         ; Alteration commands:
  210.         ("\C-c " open-sibtopic)
  211.         ("\C-c." open-subtopic)
  212.         ("\C-c," open-supertopic)
  213.         ("\C-c'" outline-shift-in)
  214.         ("\C-c>" outline-shift-in)
  215.         ("\C-c<" outline-shift-out)
  216.         ("\C-c\C-m" outline-rebullet-topic)
  217.         ("\C-cb" outline-rebullet-current-heading)
  218.         ("\C-c#" outline-number-siblings)
  219.         ("\C-k" outline-kill-line)
  220.         ("\C-y" outline-yank)
  221.         ("\M-y" outline-yank-pop)
  222.         ("\C-c\C-k" outline-kill-topic)
  223.                                         ; Miscellaneous commands:
  224.         ("\C-c@" outline-resolve-xref)
  225.         ("\C-cc" outline-copy-exposed)))
  226.  
  227. ;;;_ + Code - no user customizations below.
  228.  
  229. ;;;_  #1 Outline Format and Internal Mode Configuration
  230.  
  231. ;;;_   : Topic header format
  232. ;;;_    = outline-regexp
  233. (defvar outline-regexp ""
  234.   "*   Regular expression to match the beginning of a heading line.
  235.    Any line whose beginning matches this regexp is considered a
  236.    heading.  This var is set according to the user configuration vars
  237.    by set-outline-regexp.")
  238. (make-variable-buffer-local 'outline-regexp)
  239. ;;;_    = outline-bullets-string
  240. (defvar outline-bullets-string ""
  241.   "   A string dictating the valid set of outline topic bullets.  This
  242.    var should *not* be set by the user - it is set by 'set-outline-regexp',
  243.    and is composed from the elements of 'outline-plain-bullets-string'
  244.    and 'outline-distinctive-bullets-string'.")
  245. (make-variable-buffer-local 'outline-bullets-string)
  246. ;;;_    = outline-line-boundary-regexp
  247. (defvar outline-line-boundary-regexp ()
  248.   "   outline-regexp with outline-style beginning of line anchor (ie,
  249.    C-j, *or* C-m, for prefixes of hidden topics).  This is properly
  250.    set when outline-regexp is produced by 'set-outline-regexp', so
  251.    that (match-beginning 2) and (match-end 2) delimit the prefix.")
  252. (make-variable-buffer-local 'outline-line-boundary-regexp)
  253. ;;;_    = outline-bob-regexp
  254. (defvar outline-bob-regexp ()
  255.   " Like outline-line-boundary-regexp, this is an outline-regexp for
  256.   outline headers at the beginning of the buffer.  (match-beginning 2)
  257.   and (match-end 2)
  258.    delimit the prefix.")
  259. (make-variable-buffer-local 'outline-line-bob-regexp)
  260. ;;;_    > outline-reset-header-lead (header-lead)
  261. (defun outline-reset-header-lead (header-lead)
  262.   "*  Reset the leading string used to identify topic headers."
  263.   (interactive "sNew lead string: ")
  264.   ;;()
  265.   (setq outline-header-prefix header-lead)
  266.   (setq outline-header-subtraction (1- (length outline-header-prefix)))
  267.   (set-outline-regexp)
  268.   )
  269. ;;;_    > outline-lead-with-comment-string (header-lead)
  270. (defun outline-lead-with-comment-string (&optional header-lead)
  271.   "* Set the topic-header leading string to specified string.  Useful
  272.   when for encapsulating outline structure in programming language
  273.   comments.  Returns the leading string."
  274.  
  275.   (interactive "P")
  276.   (if (not (stringp header-lead))
  277.       (setq header-lead (read-string
  278.                          "String prefix for topic headers: ")))
  279.   (setq outline-reindent-bodies nil)
  280.   (outline-reset-header-lead header-lead)
  281.   header-lead)
  282. ;;;_    > set-outline-regexp ()
  283. (defun set-outline-regexp ()
  284.   "   Generate proper topic-header regexp form for outline functions, from
  285.    outline-plain-bullets-string and outline-distinctive-bullets-string."
  286.  
  287.   (interactive)
  288.   ;; Derive outline-bullets-string from user configured components:
  289.   (setq outline-bullets-string "")
  290.   (let ((strings (list 'outline-plain-bullets-string
  291.                        'outline-distinctive-bullets-string))
  292.         cur-string
  293.         cur-len
  294.         cur-char-string
  295.         index
  296.         new-string)
  297.     (while strings
  298.       (setq new-string "") (setq index 0)
  299.       (setq cur-len (length (setq cur-string (symbol-value (car strings)))))
  300.       (while (< index cur-len)
  301.         (setq cur-char (aref cur-string index))
  302.         (setq outline-bullets-string
  303.               (concat outline-bullets-string
  304.                       (cond
  305.                                         ; Single dash would denote a
  306.                                         ; sequence, repeated denotes
  307.                                         ; a dash:
  308.                        ((eq cur-char ?-) "--")
  309.                                         ; literal close-square-bracket
  310.                                         ; doesn't work right in the
  311.                                         ; expr, exclude it:
  312.                        ((eq cur-char ?\]) "")
  313.                        (t (regexp-quote  (char-to-string cur-char))))))
  314.         (setq index (1+ index)))
  315.       (setq strings (cdr strings)))
  316.     )
  317.   ;; Derive next for repeated use in outline-pending-bullet:
  318.   (setq outline-plain-bullets-string-len (length outline-plain-bullets-string))
  319.   (setq outline-header-subtraction (1- (length outline-header-prefix)))
  320.   ;; Produce the new outline-regexp:
  321.   (setq outline-regexp (concat "\\(\\"
  322.                                outline-header-prefix
  323.                                "[ \t]*["
  324.                                outline-bullets-string
  325.                                "]\\)\\|\\"
  326.                                outline-primary-bullet
  327.                                "+\\|\^l"))
  328.   (setq outline-line-boundary-regexp
  329.         (concat "\\([\C-j\C-m]\\)\\(" outline-regexp "\\)"))
  330.   (setq outline-bob-regexp
  331.         (concat "\\(\\`\\)\\(" outline-regexp "\\)"))
  332.   )
  333.  
  334. ;;;_   : Key bindings
  335. ;;;_    = Generic minor keybindings control
  336. ;;;_     ; Stallman's suggestion
  337. (defvar outline-mode-map nil "")
  338.  
  339. (if outline-mode-map
  340.     nil
  341.   (setq outline-mode-map (nconc (make-sparse-keymap) text-mode-map))
  342.   (define-key outline-mode-map "\C-c\C-n" 'outline-next-visible-heading)
  343.   (define-key outline-mode-map "\C-c\C-p" 'outline-previous-visible-heading)
  344.   (define-key outline-mode-map "\C-c\C-i" 'show-children)
  345.   (define-key outline-mode-map "\C-c\C-s" 'show-subtree)
  346.   (define-key outline-mode-map "\C-c\C-h" 'hide-subtree)
  347.   (define-key outline-mode-map "\C-c\C-u" 'outline-up-heading)
  348.   (define-key outline-mode-map "\C-c\C-f" 'outline-forward-same-level)
  349.   (define-key outline-mode-map "\C-c\C-b" 'outline-backward-same-level))
  350.  
  351. (defvar outline-minor-mode nil
  352.   "Non-nil if using Outline mode as a minor mode of some other mode.")
  353. (make-variable-buffer-local 'outline-minor-mode)
  354. (put 'outline-minor-mode 'permanent-local t)
  355. (setq minor-mode-alist (append minor-mode-alist
  356.                                (list '(outline-minor-mode " Outl"))))
  357.  
  358. (defvar outline-minor-mode-map nil)
  359. (if outline-minor-mode-map
  360.     nil
  361.   (setq outline-minor-mode-map (make-sparse-keymap))
  362.   (define-key outline-minor-mode-map "\C-c"
  363.     (lookup-key outline-mode-map "\C-c")))
  364.  
  365. (or (assq 'outline-minor-mode minor-mode-map-alist)
  366.     (setq minor-mode-map-alist
  367.           (cons (cons 'outline-minor-mode outline-minor-mode-map)
  368.                 minor-mode-map-alist)))
  369.  
  370. (defun outline-minor-mode (&optional arg)
  371.   "Toggle Outline minor mode.
  372. With arg, turn Outline minor mode on if arg is positive, off otherwise.
  373. See the command `outline-mode' for more information on this mode."
  374.   (interactive "P")
  375.   (setq outline-minor-mode
  376.         (if (null arg) (not outline-minor-mode)
  377.           (> (prefix-numeric-value arg) 0)))
  378.   (if outline-minor-mode
  379.       (progn
  380.         (setq selective-display t)
  381.         (run-hooks 'outline-minor-mode-hook))
  382.     (setq selective-display nil)))
  383. ;;;_     ; minor-bind-keys (keys-assoc)
  384. (defun minor-bind-keys (keys-assoc)
  385.   "   Establish BINDINGS assoc list in current buffer, returning a list
  386.    for subsequent use by minor-unbind-keys to resume overloaded local
  387.    bindings."
  388.    (interactive)
  389.    ;; Cycle thru key list, registering prevailing local binding for key, if
  390.    ;; any (for prospective resumption by outline-minor-unbind-keys), then
  391.    ;; overloading it with outline-mode one.
  392.    (let ((local-map (or (current-local-map)
  393.                         (make-sparse-keymap)))
  394.          key new-func unbinding-registry prevailing-func)
  395.      (while keys-assoc
  396.        (setq curr-key (car (car keys-assoc)))
  397.        (setq new-func (car (cdr (car keys-assoc))))
  398.        (setq prevailing-func (local-key-binding curr-key))
  399.        (if (not (symbolp prevailing-func))
  400.            (setq prevailing-func nil))
  401.        ;; Register key being changed, prevailing local binding, & new binding:
  402.        (setq unbinding-registry
  403.              (cons (list curr-key (local-key-binding curr-key) new-func)
  404.                    unbinding-registry))
  405.                                         ; Make the binding:
  406.        
  407.        (define-key local-map curr-key new-func)
  408.                                         ; Increment for next iteration:
  409.        (setq keys-assoc (cdr keys-assoc)))
  410.                                         ; Establish modified map:
  411.      (use-local-map local-map)
  412.                                         ; Return the registry:
  413.      unbinding-registry)
  414.    )
  415.  
  416. ;;;_     ; minor-relinquish-keys (unbinding-registry)
  417. (defun minor-relinquish-keys (unbinding-registry)
  418.   "   Given registry of MODAL-BINDINGS, as produced by minor-bind-keys,
  419.    resume the former local keybindings of those keys that retain the
  420.    local bindings set by minor-bind-keys.  Changed local bindings are
  421.    left alone, so other minor (user or modal) bindings are not disrupted.
  422.  
  423.    Returns a list of those registrations which were not, because of
  424.    tampering subsequent to the registration by minor-bind-keys, resumed."
  425.   (interactive)
  426.   (let (residue curr-item curr-key curr-resume curr-relinquish)
  427.     (while unbinding-registry
  428.       (setq curr-item (car unbinding-registry))
  429.       (setq curr-key (car curr-item))
  430.       (setq curr-resume (car (cdr curr-item)))
  431.       (setq curr-relinquish (car (cdr (cdr curr-item))))
  432.       (if (equal (local-key-binding curr-key) curr-relinquish)
  433.           (if curr-resume
  434.               ;; Was a local binding to be resumed - do so:
  435.               (local-set-key curr-key curr-resume)
  436.             (local-unset-key curr-key))
  437.         ;; Bindings been tampered with since registration - leave it be, and
  438.         ;; register so on residue list:
  439.         (setq residue (cons residue curr-item)))
  440.       (setq unbinding-registry (cdr unbinding-registry)))
  441.     residue)
  442.   )
  443. ;;;_    = outline-minor-prior-keys
  444. (defvar outline-minor-prior-keys ()
  445.   "Former key bindings assoc-list, for resumption from  outline minor-mode.")
  446. (make-variable-buffer-local 'outline-minor-prior-keys)
  447.  
  448.                                         ; Both major and minor mode
  449.                                         ; bindings are dictated by
  450.                                         ; this list - put your
  451.                                         ; settings here.
  452. ;;;_    > outline-minor-bind-keys ()
  453. (defun outline-minor-bind-keys ()
  454.   "   Establish outline-mode keybindings as MINOR modality of current buffer."
  455.   (setq outline-minor-prior-keys
  456.         (minor-bind-keys outline-mode-keys)))
  457. ;;;_    > outline-minor-relinquish-keys ()
  458. (defun outline-minor-relinquish-keys ()
  459.   "   Resurrect local keybindings as they were before outline-minor-bind-keys."
  460.   (minor-relinquish-keys outline-minor-prior-keys)
  461. )
  462.  
  463. ;;;_   : Mode-Specific Variables Maintenance
  464. ;;;_    = outline-mode-prior-settings
  465. (defvar outline-mode-prior-settings nil
  466.   "For internal use by outline mode, registers settings to be resumed
  467. on mode deactivation.")
  468. (make-variable-buffer-local 'outline-mode-prior-settings)
  469. ;;;_    > outline-resumptions (name &optional value)
  470. (defun outline-resumptions (name &optional value)
  471.  
  472.   " Registers information for later reference, or performs resumption of
  473.   outline-mode specific values.  First arg is NAME of variable affected.
  474.   optional second arg is list containing outline-mode-specific VALUE to
  475.   be impose on named variable, and to be registered.  (It's a list so you
  476.   can specify registrations of null values.)  If no value is specified,
  477.   the registered value is returned (encapsulated in the list, so the
  478.   caller can distinguish nil vs no value), and the registration is popped
  479.   from the list."
  480.  
  481.   (let ((on-list (assq name outline-mode-prior-settings))
  482.         prior-capsule                   ; By 'capsule' i mean a list
  483.                                         ; containing a value, so we can
  484.                                         ; distinguish nil from no value.
  485.         )
  486.  
  487.     (if value
  488.  
  489.         ;; Registering:
  490.         (progn
  491.           (if on-list
  492.               nil     ; Already preserved prior value - don't mess with it.
  493.             ;; Register the old value, or nil if previously unbound:
  494.             (setq outline-mode-prior-settings
  495.                   (cons (list name
  496.                               (if (boundp name) (list (symbol-value name))))
  497.                         outline-mode-prior-settings)))
  498.                                         ; And impose the new value:
  499.           (set name (car value)))
  500.  
  501.       ;; Relinquishing:
  502.       (if (not on-list)
  503.  
  504.           ;; Oops, not registered - leave it be:
  505.           nil
  506.  
  507.         ;; Some registration:
  508.                                         ; reestablish it:
  509.         (setq prior-capsule (car (cdr on-list)))
  510.         (if prior-capsule
  511.             (set name (car prior-capsule)) ; Some prior value - reestablish it.
  512.           (makunbound name))        ; Previously unbound - demolish var.
  513.                                         ; Remove registration:
  514.         (let (rebuild)
  515.           (while outline-mode-prior-settings
  516.             (if (not (eq (car outline-mode-prior-settings)
  517.                          on-list))
  518.                 (setq rebuild
  519.                       (cons (car outline-mode-prior-settings)
  520.                             rebuild)))
  521.             (setq outline-mode-prior-settings
  522.                   (cdr outline-mode-prior-settings)))
  523.           (setq outline-mode-prior-settings rebuild)))))
  524.   )
  525.  
  526. ;;;_   : Overall
  527. ;;;_    = outline-mode
  528. (defvar outline-mode () "Allout outline mode minor-mode flag.")
  529. (make-variable-buffer-local 'outline-mode)
  530. ;;;_    > outline-mode (&optional toggle)
  531. (defun outline-mode (&optional toggle)
  532.   "  Set minor mode for editing outlines with selective display.
  533.  
  534.    Look below the description of the bindings for explanation of the
  535.    terminology use in outline-mode commands.
  536.  
  537.    (Note - this is not a proper minor mode, because it does affect key
  538.    bindings.  It's not too improper, however, because it does resurrect
  539.    any bindings which have not been tampered with since it changed them.)
  540.  
  541. Exposure Commands              Movement Commands
  542. C-c C-h    outline-hide-current-subtree  C-c C-n outline-next-visible-heading
  543. C-c C-i    outline-show-current-children C-c C-p outline-previous-visible-heading
  544. C-c C-s    outline-show-current-subtree  C-c C-u outline-up-current-level
  545. C-c C-o    outline-show-current-entry    C-c C-f outline-forward-current-level
  546. C-c !   outline-show-all              C-c C-b outline-backward-current-level
  547.     outline-hide-current-leaves   C-c C-e outline-end-of-current-entry
  548.                                      C-c C-a outline-beginning-of-current-entry
  549.  
  550.  
  551. Topic Header Generation Commands
  552. C-c<SP>    open-sibtopic        Create a new sibling after current topic
  553. C-c .    open-subtopic        ... an offspring of current topic
  554. C-c ,    open-supertopic        ... a sibling of the current topic's parent
  555.  
  556. Level and Prefix Adjustment Commands
  557. C-c >    outline-shift-in    Shift current topic and all offspring deeper
  558. C-c <    outline-shift-out    ... less deep
  559. C-c<CR>    outline-rebullet-topic    Reconcile bullets of topic and its offspring
  560.                                 - distinctive bullets are not changed, all
  561.                                   others set suitable according to depth
  562. C-c b    outline-rebullet-current-heading Prompt for alternate bullet for
  563.                      current topic
  564. C-c #    outline-number-siblings    Number bullets of topic and siblings - the
  565.                 offspring are not affected.  With repeat
  566.                 count, revoke numbering.
  567.  
  568. Killing and Yanking - all keep siblings numbering reconciled as appropriate
  569. C-k    outline-kill-line    Regular kill line, but respects numbering ,etc
  570. C-c C-k    outline-kill-topic    Kill current topic, including offspring
  571. C-y    outline-yank        Yank, adjusting depth of yanked topic to
  572.                 depth of heading if yanking into bare topic
  573.                                 heading (ie, prefix sans text)
  574. M-y    outline-yank-pop    Is to outline-yank as yank-pop is to yank
  575.  
  576. Misc commands
  577. C-c @   outline-resolve-xref    pop-to-buffer named by xref (cf
  578.                                 outline-file-xref-bullet)
  579. C-c c    outline-copy-exposed    Copy outline sans all hidden stuff to
  580.                 another buffer whose name is derived
  581.                 from the current one - \"XXX exposed\"
  582. M-x outlinify-sticky            Activate outline mode for current buffer
  583.                                 and establish -*- outline -*- mode specifier
  584.                                 as well as file local vars to automatically
  585.                                 set exposure.  Try it.
  586.  
  587.                              Terminology
  588.  
  589. Topic: A basic cohesive component of an emacs outline, which can
  590.        be closed (made hidden), opened (revealed), generated,
  591.        traversed, and shifted as units, using outline-mode functions.
  592.        A topic is composed of a HEADER, a BODY, and SUBTOPICs (see below).
  593.  
  594. Exposure: Hidden (~closed~) topics are represented by ellipses ('...')
  595.           at the end of the visible SUPERTOPIC which contains them,
  596.           rather than by their actual text.  Hidden topics are still
  597.           susceptible to editing and regular movement functions, they
  598.           just are not displayed normally, effectively collapsed into
  599.           the ellipses which represent them.  Outline mode provides
  600.           the means to selectively expose topics based on their
  601.           NESTING.
  602.  
  603.           SUBTOPICS of a topic can be hidden and subsequently revealed
  604.           based on their DEPTH relative to the supertopic from which
  605.           the exposure is being done.
  606.  
  607.           The BODIES of a topic do not generally become visible except
  608.           during exposure of entire subtrees (see documentation for
  609.           '-current-subtree'), or when the entry is explicitly exposed
  610.           with the 'outline-show-entry' function, or (if you have a
  611.           special version of isearch installed) when encountered by
  612.           incremental searches.
  613.  
  614.           The CURRENT topic is the more recent visible one before or
  615.           including the text cursor.
  616.  
  617. Header: The initial portion of an outline topic.  It is composed of a
  618.         topic header PREFIX at the beginning of the line, followed by
  619.         text to the end of the EFFECTIVE LINE.
  620.  
  621. Body: Any subsequent lines of text following a topic header and preceding
  622.       the next one.  This is also referred to as the entry for a topic.
  623.  
  624. Prefix: The text which distinguishes topic headers from normal text
  625.         lines.  There are two forms, both of which start at the beginning
  626.         of the topic header (EFFECTIVE) line.  The length of the prefix
  627.         represents the DEPTH of the topic.  The fundamental sort begins
  628.         either with solely an asterisk ('*') or else dot ('.') followed
  629.         by zero or more spaces and then an outline BULLET.  [Note - you
  630.         can now designate your own, arbitrary HEADER-LEAD string, by
  631.         setting the variable 'outline-header-prefix'.]  The second form
  632.         is for backwards compatibility with the original emacs outline
  633.         mode, and consists solely of asterisks.  Both sorts are
  634.         recognized by all outline commands.  The first sort is generated
  635.         by outline topic production commands if the emacs variable
  636.         outline-old-style-prefixes is nil, otherwise the second style is
  637.         used.
  638.  
  639. Bullet: An outline prefix bullet is one of the characters on either
  640.         of the outline bullet string vars, 'outline-plain-bullets-string'
  641.         and 'outline-distinctive-bullets-string'.  (See their
  642.         documentation for more details.)  The default choice of bullet
  643.         for any prefix depends on the DEPTH of the topic.
  644.  
  645. Depth and Nesting:
  646.        The length of a topic header prefix, from the initial
  647.        character to the bullet (inclusive), represents the depth of
  648.        the topic.  A topic is considered to contain the subsequent
  649.        topics of greater depth up to the next topic of the same
  650.        depth, and the contained topics are recursively considered to
  651.        be nested within all containing topics.  Contained topics are
  652.        called subtopics.  Immediate subtopics are called 'children'.
  653.        Containing topics are supertopicsimmediate supertopics are
  654.        'parents'.  Contained topics of the same depth are called
  655.        siblings.
  656.  
  657. Effective line: The regular ascii text in which form outlines are
  658.                 saved are manipulated in outline-mode to engage emacs'
  659.                 selective-display faculty.  The upshot is that the
  660.                 effective end of an outline line can be terminated by
  661.                 either a normal Unix newline char, \n, or the special
  662.                 outline-mode eol, ^M.  This only matters at the user
  663.                 level when you're doing searches which key on the end of
  664.                 line character."
  665.  
  666.   (interactive "P")
  667.  
  668.   (let* ((active (and (boundp 'outline-mode) outline-mode))
  669.          (toggle (and toggle
  670.                       (or (and (listp toggle)(car toggle))
  671.                           toggle)))
  672.          (explicit-activation (and toggle
  673.                                    (or (symbolp toggle)
  674.                                        (and (natnump toggle)
  675.                                             (not (zerop toggle)))))))
  676.                                        
  677.     (cond
  678.  
  679.      ((and (not explicit-activation) (or active toggle))
  680.       ;; Activation not explicitly requested, and either in active
  681.       ;; state or deactivation specifically requested:
  682.       (outline-minor-relinquish-keys)
  683.       (outline-resumptions 'selective-display)
  684.       (outline-resumptions 'indent-tabs-mode)
  685.       (outline-resumptions 'paragraph-start)
  686.       (outline-resumptions 'paragraph-separate)
  687.       (setq outline-mode nil))
  688.  
  689.      ;; Deactivation *not* indicated.
  690.      ((not active)
  691.       ;; Not already active - activate:
  692.       (outline-minor-bind-keys)
  693.       (outline-resumptions 'selective-display '(t))
  694.       (outline-resumptions 'indent-tabs-mode '(nil))
  695.       (or (assq 'outline-mode minor-mode-alist)
  696.           (setq minor-mode-alist
  697.                 (cons '(outline-mode " Outline") minor-mode-alist)))
  698.       (set-outline-regexp)
  699.  
  700.       (make-local-variable 'paragraph-start)
  701.       (outline-resumptions 'paragraph-start
  702.                            (list (concat paragraph-start "\\|^\\("
  703.                                          outline-regexp "\\)")))
  704.       (make-local-variable 'paragraph-separate)
  705.       (outline-resumptions 'paragraph-separate
  706.                            (list (concat paragraph-separate "\\|^\\("
  707.                                          outline-regexp "\\)")))
  708.  
  709.       (if outline-enwrap-isearch-mode
  710.           (outline-enwrap-isearch))
  711.       (if (and outline-use-hanging-indents
  712.                (boundp 'filladapt-prefix-table))
  713.           ;; Add outline-prefix recognition to filladapt - not standard:
  714.           (progn (setq filladapt-prefix-table
  715.                        (cons (cons (concat "\\(" outline-regexp "\\) ")
  716.                                    'filladapt-hanging-list)
  717.                              filladapt-prefix-table))
  718.                  (setq filladapt-hanging-list-prefixes
  719.                        (cons outline-regexp
  720.                              filladapt-hanging-list-prefixes))))
  721.       (run-hooks 'outline-mode-hook)
  722.       (setq outline-mode t))
  723.      ) ; cond
  724.     ) ; let*
  725.   ) ; defun
  726.     
  727.  
  728. ;;;_  #2 Internal Position State-Tracking Variables
  729. ;;; All basic outline functions which directly do string matches to
  730. ;;; evaluate heading prefix location set the variables
  731. ;;; outline-recent-prefix-beginning and outline-recent-prefix-end when
  732. ;;; successful.  Functions starting with 'outline-recent-' all use
  733. ;;; this state, providing the means to avoid redundant searches for
  734. ;;; just established data.  This optimization can provide significant
  735. ;;; speed improvement, but it must be employed carefully.
  736. ;;;_   = outline-recent-prefix-beginning
  737. (defvar outline-recent-prefix-beginning 0
  738.   "   Buffer point of the start of the last topic prefix encountered.")
  739. (make-variable-buffer-local 'outline-recent-prefix-beginning)
  740. ;;;_   = outline-recent-prefix-end
  741. (defvar outline-recent-prefix-end 0
  742.   "   Buffer point of the end of the last topic prefix encountered.")
  743. (make-variable-buffer-local 'outline-recent-prefix-end)
  744.  
  745. ;;;_  #3 Exposure Control
  746.  
  747. ;;;_   : Fundamental
  748. ;;;_    > outline-flag-region (from to flag)
  749. (defun outline-flag-region (from to flag)
  750.   "   Hides or shows lines from FROM to TO, according to FLAG.
  751.    Uses emacs selective-display, where text is show if FLAG put at
  752.    beginning of line is `\\n' (newline character), while text is
  753.    hidden if FLAG is `\\^M' (control-M).
  754.  
  755.    returns nil iff no changes were effected."
  756.   (let ((buffer-read-only nil))
  757.     (subst-char-in-region from to
  758.                           (if (= flag ?\n) ?\^M ?\n)
  759.                           flag t)))
  760. ;;;_    > outline-flag-current-subtree (flag)
  761. (defun outline-flag-current-subtree (flag)
  762.   (save-excursion
  763.     (outline-back-to-current-heading)
  764.     (outline-flag-region (point)
  765.               (progn (outline-end-of-current-subtree) (point))
  766.               flag)))
  767.  
  768. ;;;_   : Topic-specific
  769. ;;;_    > outline-hide-current-entry ()
  770. (defun outline-hide-current-entry ()
  771.   "Hide the body directly following this heading."
  772.   (interactive)
  773.   (outline-back-to-current-heading)
  774.   (save-excursion
  775.    (outline-flag-region (point)
  776.                         (progn (outline-end-of-current-entry) (point))
  777.                         ?\^M)))
  778. ;;;_    > outline-show-current-entry (&optional arg)
  779. (defun outline-show-current-entry (&optional arg)
  780.   "Show body directly following this heading, or hide it if repeat count."
  781.   (interactive "P")
  782.   (if arg
  783.       (outline-hide-current-entry)
  784.     (save-excursion
  785.       (outline-flag-region (point)
  786.                            (progn (outline-end-of-current-entry) (point))
  787.                            ?\n))))
  788. ;;;_    > outline-show-entry ()
  789. ; outline-show-entry basically for isearch dynamic exposure, as is...
  790. (defun outline-show-entry ()
  791.   "   Like outline-show-current-entry, but reveals an entry that is nested
  792.    within hidden topics."
  793.   (interactive)
  794.   (save-excursion
  795.     (outline-goto-prefix)
  796.     (outline-flag-region (if (not (bobp)) (1- (point)) (point))
  797.                          (progn (outline-pre-next-preface) (point)) ?\n)))
  798. ;;;_    > outline-hide-current-entry-completely ()
  799. ; ... outline-hide-current-entry-completely also for isearch dynamic exposure:
  800. (defun outline-hide-current-entry-completely ()
  801.   "Like outline-hide-current-entry, but conceal topic completely."
  802.   (interactive)
  803.   (save-excursion
  804.     (outline-goto-prefix)
  805.     (outline-flag-region (if (not (bobp)) (1- (point)) (point))
  806.                          (progn (outline-pre-next-preface)
  807.                                 (if (looking-at "\C-m")
  808.                                     (point)
  809.                                   (1- (point))))
  810.                          ?\C-m)))
  811. ;;;_    > outline-show-current-subtree ()
  812. (defun outline-show-current-subtree ()
  813.   "Show everything after this heading at deeper levels."
  814.   (interactive)
  815.   (outline-flag-current-subtree ?\n))
  816. ;;;_    > outline-hide-current-subtree (&optional just-close)
  817. (defun outline-hide-current-subtree (&optional just-close)
  818.  
  819.   "   Hide everything after this heading at deeper levels, or if it's
  820.   already closed, and optional arg JUST-CLOSE is nil, hide the current
  821.   level."
  822.  
  823.   (interactive)
  824.   (let ((orig-eol (save-excursion
  825.                     (end-of-line)(outline-goto-prefix)(end-of-line)(point))))
  826.     (outline-flag-current-subtree ?\^M)
  827.     (if (and (= orig-eol (save-excursion (goto-char orig-eol)
  828.                                          (end-of-line)
  829.                                          (point)))
  830.              ;; Structure didn't change - try hiding current level:
  831.              (if (not just-close)
  832.                  (outline-up-current-level 1 t)))
  833.         (outline-hide-current-subtree))))
  834. ;;;_    > outline-show-current-branches ()
  835. (defun outline-show-current-branches ()
  836.   "Show all subheadings of this heading, but not their bodies."
  837.   (interactive)
  838.   (outline-show-current-children 1000))
  839. ;;;_    > outline-hide-current-leaves ()
  840. (defun outline-hide-current-leaves ()
  841.   "Hide all body after this heading at deeper levels."
  842.   (interactive)
  843.   (outline-back-to-current-heading)
  844.   (outline-hide-region-body (point) (progn (outline-end-of-current-subtree)
  845.                                            (point))))
  846. ;;;_    > outline-show-current-children (&optional level)
  847. (defun outline-show-current-children (&optional level)
  848.   "  Show all direct subheadings of this heading.  Optional LEVEL specifies
  849.    how many levels below the current level should be shown."
  850.   (interactive "p")
  851.   (or level (setq level 1))
  852.   (save-excursion
  853.    (save-restriction
  854.     (beginning-of-line)
  855.     (setq level (+ level (progn (outline-back-to-current-heading)
  856.                                 (outline-recent-depth))))
  857.     (narrow-to-region (point)
  858.               (progn (outline-end-of-current-subtree) (1+ (point))))
  859.     (goto-char (point-min))
  860.     (while (and (not (eobp))
  861.                 (outline-next-heading))
  862.       (if (<= (outline-recent-depth) level)
  863.       (save-excursion
  864.        (let ((end (1+ (point))))
  865.          (forward-char -1)
  866.          (if (memq (preceding-char) '(?\n ?\^M))
  867.          (forward-char -1))
  868.          (outline-flag-region (point) end ?\n))))))))
  869.  
  870. ;;;_   : Region and beyond
  871. ;;;_    > outline-show-all ()
  872. (defun outline-show-all ()
  873.   "Show all of the text in the buffer."
  874.   (interactive)
  875.   (outline-flag-region (point-min) (point-max) ?\n))
  876. ;;;_    > outline-hide-bodies ()
  877. (defun outline-hide-bodies ()
  878.   "Hide all of buffer except headings."
  879.   (interactive)
  880.   (outline-hide-region-body (point-min) (point-max)))
  881. ;;;_    > outline-hide-region-body (start end)
  882. (defun outline-hide-region-body (start end)
  883.   "Hide all body lines in the region, but not headings."
  884.   (save-excursion
  885.     (save-restriction
  886.       (narrow-to-region start end)
  887.       (goto-char (point-min))
  888.       (while (not (eobp))
  889.     (outline-flag-region (point)
  890.                              (progn (outline-pre-next-preface) (point)) ?\^M)
  891.     (if (not (eobp))
  892.         (forward-char
  893.          (if (looking-at "[\n\^M][\n\^M]")
  894.          2 1)))))))
  895. ;;;_    > outline-expose ()
  896. (defun outline-expose (spec &rest followers)
  897.  
  898.   "Dictate wholesale exposure scheme for current topic, according to SPEC.
  899.  
  900. SPEC is either a number or a list of specs.  Optional successive args
  901. dictate exposure for subsequent siblings of current topic.
  902.  
  903. Numbers, the symbols '*' and '+', and the null list dictate different
  904. exposure depths for the corresponding topic.  Numbers indicate the
  905. depth to open, with negative numbers first forcing a close, and then
  906. opening to their absolute value.  Positive numbers jsut reopen, and 0
  907. just closes.  '*' completely opens the topic, including bodies, and
  908. '+' shows all the sub headers, but not the bodies.
  909.  
  910. If the spec is a list, the first element must be a number which
  911. dictates the exposure depth of the topic as a whole.  Subsequent
  912. elements of the list are nested SPECs, dictating the specific exposure
  913. for the corresponding offspring of the topic, as the SPEC as a whole
  914. does for the parent topic.
  915.  
  916. Optional FOLLOWER elements dictate exposure for subsequent siblings
  917. of the parent topic."
  918.  
  919.   (interactive "xExposure spec: ")
  920.   (save-excursion
  921.     (let ((start-point (progn (outline-goto-prefix)(point)))
  922.           done)
  923.       (cond ((null spec) nil)
  924.             ((symbolp spec)
  925.              (if (eq spec '*) (outline-show-current-subtree))
  926.              (if (eq spec '+) (outline-show-current-branches)))
  927.             ((numberp spec)
  928.              (if (zerop spec)
  929.                  ;; Just hide if zero:
  930.                  (outline-hide-current-subtree t)
  931.                (if (> 0 spec)
  932.                    ;; Close before opening if negative:
  933.                    (progn (outline-hide-current-subtree)
  934.                           (setq spec (* -1 spec))))
  935.                (outline-show-current-children spec)))
  936.             ((listp spec)
  937.              (outline-expose (car spec))
  938.              (if (and (outline-descend-to-depth (+ (outline-current-depth) 1))
  939.                       (not (outline-hidden-p)))
  940.                  (while (and (setq spec (cdr spec))
  941.                              (not done))
  942.                    (outline-expose (car spec))
  943.                    (setq done (not (outline-next-sibling)))))))))
  944.   (while (and followers (outline-next-sibling))
  945.     (outline-expose (car followers))
  946.     (setq followers (cdr followers)))
  947.   )
  948. ;;;_    > outline-exposure '()
  949. (defmacro outline-exposure (&rest spec)
  950.   "  Literal frontend for 'outline-expose', passes arguments unevaluated,
  951.   so you needn't quote them."
  952.   (cons 'outline-expose (mapcar '(lambda (x) (list 'quote x)) spec)))
  953.  
  954. ;;;_  #4 Navigation
  955.  
  956. ;;;_   : Position Assessment
  957.  
  958. ;;;_    . Residual state - from most recent outline context operation.
  959. ;;;_     > outline-recent-depth ()
  960. (defun outline-recent-depth ()
  961.   "   Return depth of last heading encountered by an outline maneuvering
  962.    function.
  963.  
  964.    All outline functions which directly do string matches to assess
  965.    headings set the variables outline-recent-prefix-beginning and
  966.    outline-recent-prefix-end if successful.  This function uses those settings
  967.    to return the current depth."
  968.  
  969.   (max 1
  970.        (- outline-recent-prefix-end
  971.           outline-recent-prefix-beginning
  972.           outline-header-subtraction)))
  973. ;;;_     > outline-recent-prefix ()
  974. (defun outline-recent-prefix ()
  975.   "   Like outline-recent-depth, but returns text of last encountered prefix.
  976.  
  977.    All outline functions which directly do string matches to assess
  978.    headings set the variables outline-recent-prefix-beginning and
  979.    outline-recent-prefix-end if successful.  This function uses those settings
  980.    to return the current depth."
  981.   (buffer-substring outline-recent-prefix-beginning outline-recent-prefix-end))
  982. ;;;_     > outline-recent-bullet ()
  983. (defun outline-recent-bullet ()
  984.   "   Like outline-recent-prefix, but returns bullet of last encountered
  985.    prefix.
  986.  
  987.    All outline functions which directly do string matches to assess
  988.    headings set the variables outline-recent-prefix-beginning and
  989.    outline-recent-prefix-end if successful.  This function uses those settings
  990.    to return the current depth of the most recently matched topic."
  991.   (buffer-substring (1- outline-recent-prefix-end) outline-recent-prefix-end))
  992.  
  993. ;;;_    . Active position evaluation - if you can't use the residual state.
  994. ;;;_     > outline-on-current-heading-p ()
  995. (defun outline-on-current-heading-p ()
  996.   "   Return prefix beginning point if point is on same line as current
  997.    visible topic's header line."
  998.   (save-excursion
  999.     (beginning-of-line)
  1000.     (and (looking-at outline-regexp)
  1001.          (setq outline-recent-prefix-end (match-end 0)
  1002.                outline-recent-prefix-beginning (match-beginning 0)))))
  1003. ;;;_     > outline-hidden-p ()
  1004. (defun outline-hidden-p ()
  1005.   "True if point is in hidden text."
  1006.   (interactive)
  1007.   (save-excursion
  1008.     (and (re-search-backward "[\C-j\C-m]" (point-min) t)
  1009.          (looking-at "\C-m"))))
  1010. ;;;_     > outline-current-depth ()
  1011. (defun outline-current-depth ()
  1012.   "   Return the depth to which the current containing visible topic is
  1013.    nested in the outline."
  1014.   (save-excursion
  1015.     (if (outline-back-to-current-heading)
  1016.         (max 1
  1017.              (- outline-recent-prefix-end
  1018.                 outline-recent-prefix-beginning
  1019.                 outline-header-subtraction))
  1020.       0)))
  1021. ;;;_     > outline-depth ()
  1022. (defun outline-depth ()
  1023.   "   Like outline-current-depth, but respects hidden as well as visible
  1024.    topics."
  1025.   (save-excursion
  1026.     (if (outline-goto-prefix)
  1027.         (outline-recent-depth)
  1028.       (progn
  1029.         (setq outline-recent-prefix-end (point)
  1030.               outline-recent-prefix-beginning (point))
  1031.         0))))
  1032. ;;;_     > outline-get-current-prefix ()
  1033. (defun outline-get-current-prefix ()
  1034.   "   Topic prefix of the current topic."
  1035.   (save-excursion
  1036.     (if (outline-goto-prefix)
  1037.         (outline-recent-prefix))))
  1038. ;;;_     > outline-get-bullet ()
  1039. (defun outline-get-bullet ()
  1040.   "   Return bullet of containing topic (visible or not)."
  1041.   (save-excursion
  1042.     (and (outline-goto-prefix)
  1043.          (outline-recent-bullet))))
  1044. ;;;_     > outline-current-bullet ()
  1045. (defun outline-current-bullet ()
  1046.   "  Return bullet of current (visible) topic heading, or none if none found."
  1047.   (condition-case err
  1048.       (save-excursion
  1049.         (outline-back-to-current-heading)
  1050.         (buffer-substring (- outline-recent-prefix-end 1)
  1051.                           outline-recent-prefix-end))
  1052.     ;; Quick and dirty provision, ostensibly for missing bullet:
  1053.     (args-out-of-range nil))
  1054.   )
  1055. ;;;_     > outline-get-prefix-bullet (prefix)
  1056. (defun outline-get-prefix-bullet (prefix)
  1057.   "   Return the bullet of the header prefix string PREFIX."
  1058.   ;; Doesn't make sense if we're old-style prefixes, but this just
  1059.   ;; oughtn't be called then, so forget about it...
  1060.   (if (string-match outline-regexp prefix)
  1061.       (substring prefix (1- (match-end 0)) (match-end 0))))
  1062.  
  1063. ;;;_   : Within Topic
  1064. ;;;_    > outline-goto-prefix ()
  1065. (defun outline-goto-prefix ()
  1066.   "  Put point at beginning of outline prefix for current topic, visible
  1067.    or not.
  1068.  
  1069.    Returns a list of char address of the beginning of the prefix and the
  1070.    end of it, or nil if none."
  1071.  
  1072.   (cond ((and (or (save-excursion (beginning-of-line) (bobp))
  1073.                   (memq (preceding-char) '(?\n ?\^M)))
  1074.               (looking-at outline-regexp))
  1075.          (setq outline-recent-prefix-end (match-end 0)
  1076.                outline-recent-prefix-beginning
  1077.                (goto-char (match-beginning 0))))
  1078.         ((re-search-backward outline-line-boundary-regexp
  1079.                              ;; unbounded search,
  1080.                              ;; stay at limit and return nil if failed:
  1081.                              nil 1)
  1082.          (setq outline-recent-prefix-end (match-end 2)
  1083.                outline-recent-prefix-beginning
  1084.                (goto-char (match-beginning 2))))
  1085.         ;; We should be at the beginning of the buffer if the last
  1086.         ;; condition failed.  line-boundary-regexp doesn't cover topic
  1087.         ;; at bob - Check for it.
  1088.         ((looking-at outline-regexp)
  1089.          (setq outline-recent-prefix-end (match-end 0)
  1090.                outline-recent-prefix-beginning
  1091.                (goto-char (match-beginning 0)))))
  1092.  )
  1093. ;;;_    > outline-end-of-prefix ()
  1094. (defun outline-end-of-prefix ()
  1095.   "   Position cursor at beginning of header text."
  1096.   (if (not (outline-goto-prefix))
  1097.       nil
  1098.     (let ((match-data (match-data)))
  1099.       (goto-char (match-end 0))
  1100.       (while (looking-at "[0-9]") (forward-char 1))
  1101.       (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1))
  1102.       (store-match-data match-data))
  1103.     ;; Reestablish where we are:
  1104.     (outline-current-depth))
  1105.   )
  1106. ;;;_    > outline-back-to-current-heading ()
  1107. (defun outline-back-to-current-heading ()
  1108.   "   Move to heading line of current visible topic, or beginning of heading
  1109.    if already on visible heading line."
  1110.   (beginning-of-line)
  1111.   (prog1 (or (outline-on-current-heading-p)
  1112.              (and (re-search-backward (concat "^\\(" outline-regexp "\\)")
  1113.                                       nil
  1114.                                       'move)
  1115.                   (setq outline-recent-prefix-end (match-end 1)
  1116.                         outline-recent-prefix-beginning (match-beginning 1))))
  1117.     (if (interactive-p) (outline-end-of-prefix))
  1118.     )
  1119.   )
  1120. ;;;_    > outline-pre-next-preface ()
  1121. (defun outline-pre-next-preface ()
  1122.   "Skip forward to just before the next heading line.
  1123.  
  1124.    Returns that character position."
  1125.  
  1126.   (if (re-search-forward outline-line-boundary-regexp nil 'move)
  1127.       (progn (goto-char (match-beginning 0))
  1128.              (setq outline-recent-prefix-end (match-end 2)
  1129.                    outline-recent-prefix-beginning (match-beginning 2))))
  1130.   )
  1131. ;;;_    > outline-end-of-current-subtree ()
  1132. (defun outline-end-of-current-subtree ()
  1133.   "  Put point at the end of the last leaf in the currently visible topic."
  1134.   (interactive)
  1135.   (outline-back-to-current-heading)
  1136.   (let ((opoint (point))
  1137.     (level (outline-recent-depth)))
  1138.     (outline-next-heading)
  1139.     (while (and (not (eobp))
  1140.                 (> (outline-recent-depth) level))
  1141.       (outline-next-heading))
  1142.     (if (not (eobp)) (forward-char -1))
  1143.     (if (memq (preceding-char) '(?\n ?\^M)) (forward-char -1))))
  1144. ;;;_    > outline-beginning-of-current-entry ()
  1145. (defun outline-beginning-of-current-entry ()
  1146.   "   Position the point at the beginning of the body of the current topic."
  1147.   (interactive)
  1148.   (outline-end-of-prefix))
  1149. ;;;_    > outline-beginning-of-current-entry ()
  1150. (defun outline-end-of-current-entry ()
  1151.   "   Position the point at the end of the current topic's entry."
  1152.   (interactive)
  1153.   (outline-show-entry)
  1154.   (prog1 (outline-pre-next-preface)
  1155.     (if (and (not (bobp))(looking-at "^$"))
  1156.         (forward-char -1)))
  1157. )
  1158.  
  1159. ;;;_   : Depth-wise
  1160. ;;;_    > outline-ascend-to-depth (depth)
  1161. (defun outline-ascend-to-depth (depth)
  1162.   "   Ascend to depth DEPTH, returning depth if successful, nil if not."
  1163.   (if (and (> depth 0)(<= depth (outline-depth)))
  1164.       (let ((last-good (point)))
  1165.         (while (and (< depth (outline-depth))
  1166.                     (setq last-good (point))
  1167.                     (outline-beginning-of-level)
  1168.                     (outline-previous-heading)))
  1169.         (if (= (outline-recent-depth) depth)
  1170.             (progn (goto-char outline-recent-prefix-beginning)
  1171.                    depth)
  1172.           (goto-char last-good)
  1173.           nil))
  1174.     (if (interactive-p) (outline-end-of-prefix))
  1175.     )
  1176.   )
  1177. ;;;_    > outline-descend-to-depth (depth)
  1178. (defun outline-descend-to-depth (depth)
  1179.   "   Descend to depth DEPTH within current topic, returning depth if
  1180.    successful, nil if not."
  1181.   (let ((start-point (point))
  1182.         (start-depth (outline-depth)))
  1183.     (while
  1184.         (and (> (outline-depth) 0)
  1185.              (not (= depth (outline-recent-depth))) ; ... not there yet
  1186.              (outline-next-heading)     ; ... go further
  1187.              (< start-depth (outline-recent-depth)))) ; ... still in topic
  1188.     (if (and (> (outline-depth) 0)
  1189.              (= (outline-recent-depth) depth))
  1190.         depth
  1191.       (goto-char start-point)
  1192.       nil))
  1193.   )
  1194. ;;;_    > outline-up-current-level (arg &optional dont-complain)
  1195. (defun outline-up-current-level (arg &optional dont-complain)
  1196.   "   Move to the heading line of which the present line is a subheading.
  1197.    With argument, move up ARG levels.  Don't return an error if
  1198.    second, optional argument DONT-COMPLAIN, is non-nil."
  1199.   (interactive "p")
  1200.   (outline-back-to-current-heading)
  1201.   (let ((present-level (outline-recent-depth)))
  1202.     ;; Loop for iterating arg:
  1203.     (while (and (> (outline-recent-depth) 1)
  1204.                 (> arg 0)
  1205.                 (not (bobp)))
  1206.       ;; Loop for going back over current or greater depth:
  1207.       (while (and (not (< (outline-recent-depth) present-level))
  1208.                   (outline-previous-visible-heading 1)))
  1209.       (setq present-level (outline-current-depth))
  1210.       (setq arg (- arg 1)))
  1211.     )
  1212.   (prog1 (if (<= arg 0)
  1213.              outline-recent-prefix-beginning
  1214.            (if (interactive-p) (outline-end-of-prefix))
  1215.            (if (not dont-complain)
  1216.                (error "Can't ascend past outermost level.")))
  1217.     (if (interactive-p) (outline-end-of-prefix)))
  1218.   )
  1219.  
  1220. ;;;_   : Linear
  1221. ;;;_    > outline-next-visible-heading (arg)
  1222. (defun outline-next-visible-heading (arg)
  1223.   "   Move to the next visible heading line.
  1224.  
  1225.    With argument, repeats, backward if negative."
  1226.   (interactive "p")
  1227.   (if (< arg 0) (beginning-of-line) (end-of-line))
  1228.   (if (re-search-forward (concat "^\\(" outline-regexp "\\)")
  1229.                          nil
  1230.                          'go
  1231.                          arg)
  1232.       (progn (outline-end-of-prefix)
  1233.              (setq outline-recent-prefix-end (match-end 1)
  1234.                    outline-recent-prefix-beginning (match-beginning 1))))
  1235.   )
  1236. ;;;_    > outline-previous-visible-heading (arg)
  1237. (defun outline-previous-visible-heading (arg)
  1238.   "   Move to the previous heading line.
  1239.  
  1240.    With argument, repeats or can move forward if negative.
  1241.    A heading line is one that starts with a `*' (or that outline-regexp
  1242.    matches)."
  1243.   (interactive "p")
  1244.   (outline-next-visible-heading (- arg))
  1245.   )
  1246. ;;;_    > outline-next-heading (&optional backward)
  1247. (defun outline-next-heading (&optional backward)
  1248.   "   Move to the heading for the topic (possibly invisible) before this one.
  1249.  
  1250.    Optional arg BACKWARD means search for most recent prior heading.
  1251.  
  1252.    Returns the location of the heading, or nil if none found."
  1253.  
  1254.   (if (and backward (bobp))
  1255.       nil
  1256.     (if backward (outline-goto-prefix)
  1257.       (if (and (bobp) (not (eobp)))
  1258.           (forward-char 1)))
  1259.  
  1260.     (if (if backward
  1261.             ;; searches are unbounded and return nil if failed:
  1262.             (or (re-search-backward outline-line-boundary-regexp
  1263.                                     nil
  1264.                                     0)
  1265.                 (looking-at outline-bob-regexp))
  1266.           (re-search-forward outline-line-boundary-regexp
  1267.                              nil
  1268.                              0))
  1269.         (progn;; Got some valid location state - set vars:
  1270.           (setq outline-recent-prefix-end
  1271.                 (or (match-end 2) outline-recent-prefix-end))
  1272.           (goto-char (setq outline-recent-prefix-beginning
  1273.                            (or (match-beginning 2)
  1274.                                outline-recent-prefix-beginning))))
  1275.       )
  1276.     )
  1277.   )
  1278. ;;;_    > outline-previous-heading ()
  1279. (defun outline-previous-heading ()
  1280.   "   Move to the next (possibly invisible) heading line.
  1281.  
  1282.    Optional repeat-count arg means go that number of headings.
  1283.  
  1284.    Return the location of the beginning of the heading, or nil if not found."
  1285.  
  1286.   (outline-next-heading t)
  1287.   )
  1288. ;;;_    > outline-next-sibling (&optional backward)
  1289. (defun outline-next-sibling (&optional backward)
  1290.   "   Like outline-forward-current-level, but respects invisible topics.
  1291.  
  1292.    Go backward if optional arg BACKWARD is non-nil.
  1293.  
  1294.    Return depth if successful, nil otherwise."
  1295.  
  1296.   (if (and backward (bobp))
  1297.       nil
  1298.     (let ((start-depth (outline-depth))
  1299.           (start-point (point))
  1300.           last-good)
  1301.       (while (and (not (if backward (bobp) (eobp)))
  1302.                   (if backward (outline-previous-heading)
  1303.                     (outline-next-heading))
  1304.                   (> (outline-recent-depth) start-depth)))
  1305.       (if (and (not (eobp))
  1306.                (and (> (outline-depth) 0)
  1307.                     (= (outline-recent-depth) start-depth)))
  1308.           outline-recent-prefix-beginning
  1309.         (goto-char start-point)
  1310.         nil)
  1311.       )
  1312.     )
  1313.   )
  1314. ;;;_    > outline-previous-sibling (&optional arg)
  1315. (defun outline-previous-sibling (&optional arg)
  1316.   "   Like outline-forward-current-level, but goes backwards and respects
  1317.    invisible topics.
  1318.  
  1319.    Optional repeat count means go number backward.
  1320.  
  1321.    Note that the beginning of a level is (currently) defined by this
  1322.    implementation to be the first of previous successor topics of
  1323.    equal or greater depth.
  1324.  
  1325.    Return depth if successful, nil otherwise."
  1326.   (outline-next-sibling t)
  1327.   )
  1328. ;;;_    > outline-beginning-of-level ()
  1329. (defun outline-beginning-of-level ()
  1330.   "   Go back to the first sibling at this level, visible or not."
  1331.   (outline-end-of-level 'backward))
  1332. ;;;_    > outline-end-of-level (&optional backward)
  1333. (defun outline-end-of-level (&optional backward)
  1334.   "   Go to the last sibling at this level, visible or not."
  1335.  
  1336.   (while (outline-previous-sibling))
  1337.   (prog1 (outline-recent-depth)
  1338.     (if (interactive-p) (outline-end-of-prefix)))
  1339. )
  1340. ;;;_    > outline-forward-current-level (arg &optional backward)
  1341. (defun outline-forward-current-level (arg &optional backward)
  1342.   "   Position the point at the next heading of the same level, taking
  1343.    optional repeat-count.
  1344.  
  1345.    Returns that position, else nil if is not found."
  1346.   (interactive "p")
  1347.   (outline-back-to-current-heading)
  1348.       (let ((amt (if arg (if (< arg 0)
  1349.                              ;; Negative arg - invert direction.
  1350.                              (progn (setq backward (not backward))
  1351.                                     (abs arg))
  1352.                            arg);; Positive arg - just use it.
  1353.                    1)));; No arg - use 1:
  1354.         (while (and (> amt 0)
  1355.                     (outline-next-sibling backward))
  1356.           (setq amt (1- amt)))
  1357.         (if (interactive-p) (outline-end-of-prefix))
  1358.         (if (> amt 0)
  1359.             (error "This is the %s topic on level %d."
  1360.                    (if backward "first" "last")
  1361.                    (outline-current-depth))
  1362.           t)
  1363.         )
  1364.   )
  1365. ;;;_    > outline-backward-current-level (arg)
  1366. (defun outline-backward-current-level (arg)
  1367.   "   Position the point at the previous heading of the same level, taking
  1368.    optional repeat-count.
  1369.  
  1370.    Returns that position, else nil if is not found."
  1371.   (interactive "p")
  1372.   (unwind-protect
  1373.       (outline-forward-current-level arg t)
  1374.     (outline-end-of-prefix))
  1375. )
  1376.  
  1377. ;;;_   : Search with Dynamic Exposure (requires isearch-mode)
  1378. ;;;_    = outline-search-reconceal
  1379. (defvar outline-search-reconceal nil
  1380.   "Used for outline isearch provisions, to track whether current search
  1381. match was concealed outside of search.  The value is the location of the
  1382. match, if it was concealed, regular if the entire topic was concealed, in
  1383. a list if the entry was concealed.")
  1384. ;;;_    = outline-search-quitting
  1385. (defconst outline-search-quitting nil
  1386.   "Variable used by isearch-terminate/outline-provisions and
  1387. isearch-done/outline-provisions to distinguish between a conclusion
  1388. and cancellation of a search.")
  1389.  
  1390. ;;;_    > outline-enwrap-isearch ()
  1391. (defun outline-enwrap-isearch ()
  1392.   "   Impose isearch-mode wrappers so isearch progressively exposes and
  1393.    reconceals hidden topics when working in outline mode, but works
  1394.    elsewhere.
  1395.  
  1396.    The function checks to ensure that the rebindings are done only once."
  1397.  
  1398.                                         ; Should isearch-mode be employed,
  1399.   (if (or (not outline-enwrap-isearch-mode)
  1400.                                         ; or are preparations already done?
  1401.           (fboundp 'real-isearch-terminate))
  1402.  
  1403.       ;; ... no - skip this all:
  1404.       nil
  1405.  
  1406.     ;; ... yes:
  1407.  
  1408.                                         ; Ensure load of isearch-mode:
  1409.     (if (or (and (fboundp 'isearch-mode)
  1410.                  (fboundp 'isearch-quote-char))
  1411.             (condition-case error 
  1412.                 (load-library outline-enwrap-isearch-mode)
  1413.               (file-error (message "Skipping isearch-mode provisions - %s '%s'"
  1414.                                    (car (cdr error))
  1415.                                    (car (cdr (cdr error))))
  1416.                           (sit-for 1)
  1417.                           ;; Inhibit subsequent tries and return nil:
  1418.                           (setq outline-enwrap-isearch-mode nil))))
  1419.         ;; Isearch-mode loaded, encapsulate specific entry points for
  1420.         ;; outline dynamic-exposure business:
  1421.         (progn 
  1422.                 
  1423.                                         ; stash crucial isearch-mode
  1424.                                         ; funcs under known, private
  1425.                                         ; names, then register wrapper
  1426.                                         ; functions under the old
  1427.                                         ; names, in their stead:
  1428.                                         ; 'isearch-quit' is pre v 1.2:
  1429.           (fset 'real-isearch-terminate
  1430.                                         ; 'isearch-quit is pre v 1.2:
  1431.                 (or (if (fboundp 'isearch-quit)
  1432.                         (symbol-function 'isearch-quit))
  1433.                     (if (fboundp 'isearch-abort)
  1434.                                         ; 'isearch-abort' is v 1.2 and on:
  1435.                         (symbol-function 'isearch-abort))))
  1436.           (fset 'isearch-quit 'isearch-terminate/outline-provisions)
  1437.           (fset 'isearch-abort 'isearch-terminate/outline-provisions)
  1438.           (fset 'real-isearch-done (symbol-function 'isearch-done))
  1439.           (fset 'isearch-done 'isearch-done/outline-provisions)
  1440.           (fset 'real-isearch-update (symbol-function 'isearch-update))
  1441.           (fset 'isearch-update 'isearch-update/outline-provisions)
  1442.           (make-variable-buffer-local 'outline-search-reconceal))
  1443.       )
  1444.     )
  1445.   )
  1446. ;;;_    > outline-isearch-arrival-business ()
  1447. (defun outline-isearch-arrival-business ()
  1448.   "   Do outline business like exposing current point, if necessary,
  1449.    registering reconcealment requirements in outline-search-reconceal
  1450.    accordingly.
  1451.  
  1452.    Set outline-search-reconceal to nil if current point is not
  1453.    concealed, to value of point if entire topic is concealed, and a
  1454.    list containing point if only the topic body is concealed.
  1455.  
  1456.    This will be used to determine whether outline-hide-current-entry
  1457.    or outline-hide-current-entry-completely will be necessary to
  1458.    restore the prior concealment state."
  1459.  
  1460.   (if (and (boundp 'outline-mode) outline-mode)
  1461.       (setq outline-search-reconceal
  1462.             (if (outline-hidden-p)
  1463.                 (save-excursion
  1464.                   (if (re-search-backward outline-line-boundary-regexp nil 1)
  1465.                       ;; Nil value means we got to b-o-b - wouldn't need
  1466.                       ;; to advance.
  1467.                       (forward-char 1))
  1468.                                         ; We'll return point or list
  1469.                                         ; containing point, depending
  1470.                                         ; on concealment state of
  1471.                                         ; topic prefix.
  1472.                   (prog1 (if (outline-hidden-p) (point) (list (point)))
  1473.                                         ; And reveal the current
  1474.                                         ; search target:
  1475.                     (outline-show-entry)))))))
  1476. ;;;_    > outline-isearch-advancing-business ()
  1477. (defun outline-isearch-advancing-business ()
  1478.   "   Do outline business like deexposing current point, if necessary,
  1479.    according to reconceal state registration."
  1480.   (if (and (boundp 'outline-mode) outline-mode outline-search-reconceal)
  1481.       (save-excursion
  1482.         (if (listp outline-search-reconceal)
  1483.             ;; Leave the topic visible:
  1484.             (progn (goto-char (car outline-search-reconceal))
  1485.                    (outline-hide-current-entry))
  1486.           ;; Rehide the entire topic:
  1487.           (goto-char outline-search-reconceal)
  1488.           (outline-hide-current-entry-completely))))
  1489.   )
  1490. ;;;_    > isearch-terminate/outline-provisions ()
  1491. (defun isearch-terminate/outline-provisions ()
  1492.   (interactive)
  1493.     (if (and (boundp 'outline-mode)
  1494.              outline-mode
  1495.              outline-enwrap-isearch-mode)
  1496.         (outline-isearch-advancing-business))
  1497.     (let ((outline-search-quitting t)
  1498.           (outline-search-reconceal nil))
  1499.       (real-isearch-terminate)))
  1500. ;;;_    > isearch-done/outline-provisions ()
  1501. (defun isearch-done/outline-provisions (&optional nopush)
  1502.   (interactive)
  1503.   (if (and (boundp 'outline-mode)
  1504.            outline-mode
  1505.            outline-enwrap-isearch-mode)
  1506.       (progn (save-excursion
  1507.                (if (and outline-search-reconceal
  1508.                         (not (listp outline-search-reconceal)))
  1509.                    ;; The topic was concealed - reveal it, its siblings,
  1510.                    ;; and any ancestors that are still concealed:
  1511.                    (progn
  1512.                      (message "(exposing destination)")(sit-for 0)
  1513.                      ;; Ensure target topic's siblings are exposed:
  1514.                      (outline-ascend-to-depth (1- (outline-current-depth)))
  1515.                      ;; Ensure that the target topic's ancestors are exposed
  1516.                      (while (outline-hidden-p)
  1517.                        (outline-show-current-children))
  1518.                      (outline-show-current-children)
  1519.                      (outline-show-current-entry)))
  1520.                (outline-isearch-arrival-business))
  1521.              (if (not (and (boundp 'outline-search-quitting)
  1522.                            outline-search-quitting))
  1523.                  (outline-show-current-children))))
  1524.   (if nopush
  1525.       ;; isearch-done in newer version of isearch mode takes arg:
  1526.       (real-isearch-done nopush)
  1527.     (real-isearch-done)))
  1528. ;;;_    > isearch-update/outline-provisions ()
  1529. (defun isearch-update/outline-provisions ()
  1530.   "    Wrapper around isearch which exposes and conceals hidden outline
  1531.    portions encountered in the course of searching."
  1532.   (if (not (and (boundp 'outline-mode)
  1533.                 outline-mode
  1534.                 outline-enwrap-isearch-mode))
  1535.       ;; Just do the plain business:
  1536.       (real-isearch-update)
  1537.  
  1538.     ;; Ah - provide for outline conditions:
  1539.     (outline-isearch-advancing-business)
  1540.     (real-isearch-update)
  1541.     (cond (isearch-success (outline-isearch-arrival-business))
  1542.           ((not isearch-success) (outline-isearch-advancing-business)))
  1543.     )
  1544.   )
  1545.  
  1546. ;;;_  #5 Manipulation
  1547.  
  1548. ;;;_   : Topic Format Assessment
  1549. ;;;_    > outline-solicit-alternate-bullet (depth &optional current-bullet)
  1550. (defun outline-solicit-alternate-bullet (depth &optional current-bullet)
  1551.  
  1552.   "   Prompt for and return a bullet char as an alternative to the
  1553.    current one, but offer one suitable for current depth DEPTH
  1554.    as default."
  1555.  
  1556.   (let* ((default-bullet (or current-bullet
  1557.                              (outline-bullet-for-depth depth)))
  1558.      (choice (solicit-char-in-string
  1559.                   (format "Select bullet: %s ('%s' default): "
  1560.                           outline-bullets-string
  1561.                           default-bullet)
  1562.                   (string-sans-char outline-bullets-string ?\\)
  1563.                   t)))
  1564.     (if (string= choice "") default-bullet choice))
  1565.   )
  1566. ;;;_    > outline-sibling-index (&optional depth)
  1567. (defun outline-sibling-index (&optional depth)
  1568.   "   Item number of this prospective topic among it's siblings.
  1569.  
  1570.    If optional arg depth is greater than current depth, then we're
  1571.    opening a new level, and return 0.
  1572.  
  1573.    If less than this depth, ascend to that depth and count..."
  1574.  
  1575.   (save-excursion
  1576.     (cond ((and depth (<= depth 0) 0))
  1577.           ((or (not depth) (= depth (outline-depth)))
  1578.            (let ((index 1))
  1579.              (while (outline-previous-sibling) (setq index (1+ index)))
  1580.              index))
  1581.           ((< depth (outline-recent-depth))
  1582.            (outline-ascend-to-depth depth)
  1583.            (outline-sibling-index))
  1584.           (0))))
  1585. ;;;_    > outline-distinctive-bullet (bullet)
  1586. (defun outline-distinctive-bullet (bullet)
  1587.   "   True if bullet is one of those on outline-distinctive-bullets-string."
  1588.   (string-match (regexp-quote bullet) outline-distinctive-bullets-string))
  1589. ;;;_    > outline-numbered-type-prefix (&optional prefix)
  1590. (defun outline-numbered-type-prefix (&optional prefix)
  1591.   "   True if current header prefix bullet is numbered bullet."
  1592.   (and outline-numbered-bullet
  1593.         (string= outline-numbered-bullet
  1594.                  (if prefix
  1595.                      (outline-get-prefix-bullet prefix)
  1596.                    (outline-get-bullet)))))
  1597. ;;;_    > outline-bullet-for-depth (&optional depth)
  1598. (defun outline-bullet-for-depth (&optional depth)
  1599.   "   Return outline topic bullet suited to DEPTH, or for current depth if none
  1600.    specified."
  1601.   ;; Find bullet in plain-bullets-string modulo DEPTH.
  1602.   (if outline-stylish-prefixes
  1603.       (char-to-string (aref outline-plain-bullets-string
  1604.                             (% (max 0 (- depth 2))
  1605.                                outline-plain-bullets-string-len)))
  1606.     outline-primary-bullet)
  1607.   )
  1608.  
  1609. ;;;_   : Topic Production
  1610. ;;;_    > outline-make-topic-prefix (&optional prior-bullet
  1611. (defun outline-make-topic-prefix (&optional prior-bullet
  1612.                                             new
  1613.                                             depth
  1614.                                             solicit
  1615.                                             number-control
  1616.                                             index)
  1617.   ;; Depth null means use current depth, non-null means we're either
  1618.   ;; opening a new topic after current topic, lower or higher, or we're
  1619.   ;; changing level of current topic.
  1620.   ;; Solicit dominates specified bullet-char.
  1621.   "   Generate a topic prefix suitable for optional arg DEPTH, or current
  1622.    depth if not specified.
  1623.  
  1624.    All the arguments are optional.
  1625.  
  1626.    PRIOR-BULLET indicates the bullet of the prefix being changed, or
  1627.    nil if none.  This bullet may be preserved (other options
  1628.    notwithstanding) if it is on the outline-distinctive-bullets-string,
  1629.    for instance.
  1630.  
  1631.    Second arg NEW indicates that a new topic is being opened after the
  1632.    topic at point, if non-nil.  Default bullet for new topics, eg, may
  1633.    be set (contingent to other args) to numbered bullets if previous
  1634.    sibling is one.  The implication otherwise is that the current topic
  1635.    is being adjusted - shifted or rebulleted - and we don't consider
  1636.    bullet or previous sibling.
  1637.  
  1638.    Third arg DEPTH forces the topic prefix to that depth, regardless of
  1639.    the current topics' depth.
  1640.  
  1641.    Fourth arg SOLICIT non-nil provokes solicitation from the user of a
  1642.    choice among the valid bullets.  (This overrides other all the
  1643.    options, including, eg, a distinctive PRIOR-BULLET.)
  1644.  
  1645.    Fifth arg, NUMBER-CONTROL, matters only if 'outline-numbered-bullet'
  1646.    is non-nil *and* soliciting was not explicitly invoked.  Then
  1647.    NUMBER-CONTROL non-nil forces prefix to either numbered or
  1648.    denumbered format, depending on the value of the sixth arg, INDEX.
  1649.  
  1650.    (Note that NUMBER-CONTROL does *not* apply to level 1 topics.  Sorry...)
  1651.  
  1652.    If NUMBER-CONTROL is non-nil and sixth arg INDEX is non-nil then
  1653.    the prefix of the topic is forced to be numbered.  Non-nil
  1654.    NUMBER-CONTROL and nil INDEX forces non-numbered format on the
  1655.    bullet.  Non-nil NUMBER-CONTROL and non-nil, non-number INDEX means
  1656.    that the index for the numbered prefix will be derived, by counting
  1657.    siblings back to start of level.  If INDEX is a number, then that
  1658.    number is used as the index for the numbered prefix (allowing, eg,
  1659.    sequential renumbering to not require this function counting back the
  1660.    index for each successive sibling)."
  1661.  
  1662.   ;; The options are ordered in likely frequence of use, most common
  1663.   ;; highest, least lowest.  Ie, more likely to be doing prefix
  1664.   ;; adjustments than soliciting, and yet more than numbering.
  1665.   ;; Current prefix is least dominant, but most likely to be commonly
  1666.   ;; specified...
  1667.  
  1668.   (let* (body
  1669.          numbering
  1670.          denumbering
  1671.          (depth (or depth (outline-depth)))
  1672.          (header-lead outline-header-prefix)
  1673.          (bullet-char
  1674.  
  1675.           ;; Getting value for bullet char is practically the whole job:
  1676.  
  1677.           (cond
  1678.                                         ; Simplest situation - level 1:
  1679.            ((<= depth 1) (setq header-lead "") outline-primary-bullet)
  1680.                                         ; Simple, too: all asterisks:
  1681.            (outline-old-style-prefixes
  1682.             ;; Cheat - make body the whole thing, null out header-lead and
  1683.             ;; bullet-char:
  1684.             (setq body (make-string depth
  1685.                                     (string-to-char outline-primary-bullet)))
  1686.             (setq header-lead "")
  1687.             "")
  1688.  
  1689.            ;; (Neither level 1 nor old-style, so we're space padding.
  1690.            ;; Sneak it in the condition of the next case, whatever it is.)
  1691.  
  1692.            ;; Solicitation overrides numbering and other cases:
  1693.            ((progn (setq body (make-string (- depth 2) ?\ ))
  1694.                    ;; The actual condition:
  1695.                    solicit)
  1696.             (let* ((got (outline-solicit-alternate-bullet depth)))
  1697.               ;; Gotta check whether we're numbering and got a numbered bullet:
  1698.               (setq numbering (and outline-numbered-bullet
  1699.                                    (not (and number-control (not index)))
  1700.                                    (string= got outline-numbered-bullet)))
  1701.               ;; Now return what we got, regardless:
  1702.               got))
  1703.  
  1704.            ;; Numbering invoked through args:
  1705.            ((and outline-numbered-bullet number-control)
  1706.             (if (setq numbering (not (setq denumbering (not index))))
  1707.                 outline-numbered-bullet
  1708.               (if (and current-bullet
  1709.                        (not (string= outline-numbered-bullet
  1710.                                      current-bullet)))
  1711.                   current-bullet
  1712.                 (outline-bullet-for-depth depth))))
  1713.  
  1714.           ;;; Neither soliciting nor controlled numbering ;;;
  1715.              ;;; (may be controlled denumbering, tho) ;;;
  1716.  
  1717.            ;; Check wrt previous sibling:
  1718.            ((and new                  ; only check for new prefixes
  1719.                  (<= depth (outline-depth))
  1720.                  outline-numbered-bullet          ; ... & numbering enabled
  1721.                  (not denumbering)
  1722.                  (let ((sibling-bullet
  1723.                         (save-excursion
  1724.                           ;; Locate correct sibling:
  1725.                           (or (>= depth (outline-depth))
  1726.                               (outline-ascend-to-depth depth))
  1727.                           (outline-get-bullet))))
  1728.                    (if (and sibling-bullet
  1729.                             (string= outline-numbered-bullet sibling-bullet))
  1730.                        (setq numbering sibling-bullet)))))
  1731.  
  1732.            ;; Distinctive prior bullet?
  1733.            ((and prior-bullet
  1734.                  (outline-distinctive-bullet prior-bullet)
  1735.                  ;; Either non-numbered:
  1736.                  (or (not (and outline-numbered-bullet
  1737.                                (string= prior-bullet outline-numbered-bullet)))
  1738.                      ;; or numbered, and not denumbering:
  1739.                      (setq numbering (not denumbering)))
  1740.                  ;; Here 'tis:
  1741.                  prior-bullet))
  1742.  
  1743.            ;; Else, standard bullet per depth:
  1744.            ((outline-bullet-for-depth depth)))))
  1745.  
  1746.     (concat header-lead
  1747.             body
  1748.             bullet-char
  1749.             (if numbering
  1750.                 (format "%d" (cond ((and index (numberp index)) index)
  1751.                                    (new (1+ (outline-sibling-index depth)))
  1752.                                    ((outline-sibling-index))))))
  1753.     )
  1754.   )
  1755. ;;;_    > open-topic (relative-depth &optional before)
  1756. (defun open-topic (relative-depth &optional before)
  1757.   " Open a new topic at depth DEPTH.  New topic is situated after current
  1758.   one, unless optional flag BEFORE is non-nil, or unless current line
  1759.   is complete empty (not even whitespace), in which case open is done
  1760.   on current line.
  1761.  
  1762.   Nuances:
  1763.  
  1764.    - Creation of new topics is with respect to the visible topic
  1765.      containing the cursor, regardless of intervening concealed ones.
  1766.  
  1767.    - New headers are generally created after/before the body of a
  1768.      topic.  However, they are created right at cursor location if the
  1769.      cursor is on a blank line, even if that breaks the current topic
  1770.      body.  This is intentional, to provide a simple means for
  1771.      deliberately dividing topic bodies.
  1772.  
  1773.    - Double spacing of topic lists is preserved.  Also, the first
  1774.      level two topic is created double-spaced (and so would be
  1775.      subsequent siblings, if that's left intact).  Otherwise,
  1776.      single-spacing is used.
  1777.  
  1778.    - Creation of sibling or nested topics is with respect to the topic
  1779.      you're starting from, even when creating backwards.  This way you
  1780.      can easily create a sibling in front of the current topic without
  1781.      having to go to its preceding sibling, and then open forward
  1782.      from there."
  1783.  
  1784.   (let* ((depth (+ (outline-current-depth) relative-depth))
  1785.          (opening-on-blank (if (looking-at "^\$")
  1786.                                (not (setq before nil))))
  1787.          opening-numbered    ; Will get while computing ref-topic, below
  1788.          ref-depth        ; Will get while computing ref-topic, next
  1789.          (ref-topic (save-excursion
  1790.                       (cond ((< relative-depth 0)
  1791.                              (outline-ascend-to-depth depth))
  1792.                             ((>= relative-depth 1) nil)
  1793.                             (t (outline-back-to-current-heading)))
  1794.                       (setq ref-depth (outline-recent-depth))
  1795.                       (setq opening-numbered
  1796.                             (save-excursion
  1797.                               (and outline-numbered-bullet
  1798.                                    (or (<= relative-depth 0)
  1799.                                        (outline-descend-to-depth depth))
  1800.                                    (if (outline-numbered-type-prefix)
  1801.                                        outline-numbered-bullet))))
  1802.                       (point)))
  1803.          dbl-space
  1804.          doing-beginning
  1805.          )
  1806.  
  1807.     (if (not opening-on-blank)
  1808.                                         ; Positioning and vertical
  1809.                                         ; padding - only if not
  1810.                                         ; opening-on-blank:
  1811.         (progn 
  1812.           (goto-char ref-topic)
  1813.           (setq dbl-space               ; Determine double space action:
  1814.                 (or (and (not (> relative-depth 0))
  1815.                          ;; not descending,
  1816.                          (save-excursion
  1817.                            ;; preceded by a blank line?
  1818.                            (forward-line -1)
  1819.                            (looking-at "^\\s-*$")))
  1820.                     (and (= ref-depth 1)
  1821.                          (or before
  1822.                              (= depth 1)
  1823.                              (save-excursion
  1824.                                ;; Don't already have following
  1825.                                ;; vertical padding:
  1826.                                (not (outline-pre-next-preface)))))))
  1827.  
  1828.                                         ; Position to prior heading,
  1829.                                         ; if inserting backwards:
  1830.           (if before (progn (outline-back-to-current-heading)
  1831.                             (setq doing-beginning (bobp))
  1832.                             (if (and (not (outline-previous-sibling))
  1833.                                      (not (bobp)))
  1834.                                 (outline-previous-heading))))
  1835.  
  1836.           (if (and (<= depth ref-depth)
  1837.                    (= ref-depth (outline-current-depth)))
  1838.               ;; Not going inwards, don't snug up:
  1839.               (if doing-beginning
  1840.                   (open-line (if dbl-space 2 1))
  1841.                 (outline-end-of-current-subtree))
  1842.             ;; Going inwards - double-space if first offspring is,
  1843.             ;; otherwise snug up.
  1844.             (end-of-line)        ; So we skip any concealed progeny.
  1845.             (outline-pre-next-preface)
  1846.             (if (bolp)
  1847.                 ;; Blank lines between current header body and next
  1848.                 ;; header - get to last substantive (non-white-space)
  1849.                 ;; line in body:
  1850.                 (re-search-backward "[^ \t\n]" nil t))
  1851.             (if (save-excursion
  1852.                   (outline-next-heading)
  1853.                   (if (> (outline-recent-depth) ref-depth)
  1854.                       ;; This is an offspring.
  1855.                       (progn (forward-line -1)
  1856.                              (looking-at "^\\s-*$"))))
  1857.                 (progn (forward-line 1)
  1858.                        (open-line 1)))
  1859.             (end-of-line))
  1860.           ;;(if doing-beginning (goto-char doing-beginning))
  1861.           (if (not (bobp)) (newline (if dbl-space 2 1)))
  1862.           ))
  1863.     (insert-string (concat (outline-make-topic-prefix opening-numbered
  1864.                                                       t
  1865.                                                       depth)
  1866.                            " "))
  1867.  
  1868.     ;;(if doing-beginning (save-excursion (newline (if dbl-space 2 1))))
  1869.  
  1870.  
  1871.     (outline-rebullet-heading nil        ;;; solicit
  1872.                               depth         ;;; depth
  1873.                               nil         ;;; number-control
  1874.                               nil        ;;; index
  1875.                               t)     (end-of-line)
  1876.     )
  1877.   )
  1878. ;;;_    > open-subtopic (arg)
  1879. (defun open-subtopic (arg)
  1880.   "   Open new topic header at deeper level than the current one.
  1881.  
  1882.   Negative universal arg means to open deeper, but place the new topic
  1883.   prior to the current one."
  1884.   (interactive "p")
  1885.   (open-topic 1 (> 0 arg)))
  1886. ;;;_    > open-sibtopic (arg)
  1887. (defun open-sibtopic (arg)
  1888.   "   Open new topic header at same level as the current one.  Negative
  1889.   universal arg means to place the new topic prior to the current
  1890.   one."
  1891.   (interactive "p")
  1892.   (open-topic 0 (> 0 arg)))
  1893. ;;;_    > open-supertopic (arg)
  1894. (defun open-supertopic (arg)
  1895.   "   Open new topic header at shallower level than the current one.
  1896.   Negative universal arg means to open shallower, but place the new
  1897.   topic prior to the current one."
  1898.  
  1899.   (interactive "p")
  1900.   (open-topic -1 (> 0 arg)))
  1901.  
  1902. ;;;_   : Outline Alteration
  1903. ;;;_    . Topic Form Modification
  1904. ;;;_     > outline-reindent-body (old-depth new-depth)
  1905. (defun outline-reindent-body (old-depth new-depth)
  1906.   "  Reindent body lines which were indented at old-depth to new-depth.
  1907.  
  1908.   Note that refill of indented paragraphs is not done, and tabs are
  1909.   not accommodated.  ('untabify' your outline if you want to preserve
  1910.   hanging body indents.)"
  1911.  
  1912.   (save-excursion
  1913.     (save-restriction
  1914.       (outline-goto-prefix)
  1915.       (forward-char 1)
  1916.       (let* ((old-spaces-expr (make-string (1+ old-depth) ?\ ))
  1917.              (new-spaces-expr (concat (make-string (1+ new-depth) ?\ )
  1918.                                       ;; spaces followed by non-space:
  1919.                                       "\\1")))
  1920.         (while (and (re-search-forward "[\C-j\C-m]" nil t)
  1921.                     (not (looking-at outline-regexp)))
  1922.           (if (looking-at old-spaces-expr)
  1923.               (replace-match new-spaces-expr)))))))
  1924. ;;;_     > outline-rebullet-current-heading (arg)
  1925. (defun outline-rebullet-current-heading (arg)
  1926.   "   Like non-interactive version 'outline-rebullet-heading', but work on
  1927.    (only) visible heading containing point.
  1928.  
  1929.    With repeat count, solicit for bullet."
  1930.   (interactive "P")
  1931.   (save-excursion (outline-back-to-current-heading)
  1932.                   (outline-end-of-prefix)
  1933.                   (outline-rebullet-heading (not arg)    ;;; solicit
  1934.                                             nil        ;;; depth
  1935.                                             nil        ;;; number-control
  1936.                                             nil        ;;; index
  1937.                                             t)        ;;; do-successors
  1938.                   )
  1939.   )
  1940. ;;;_     > outline-rebullet-heading (&optional solicit ...)
  1941. (defvar current-bullet nil
  1942.   "Variable local to outline-rebullet-heading,but referenced by
  1943. outline-make-topic-prefix, also.  Should be resolved with explicitly
  1944. parameterized communication between the two, if suitable.")
  1945. (defun outline-rebullet-heading (&optional solicit
  1946.                                            new-depth
  1947.                                            number-control
  1948.                                            index
  1949.                                            do-successors)
  1950.  
  1951.   "   Adjust bullet of current topic prefix.
  1952.  
  1953.    All args are optional.
  1954.  
  1955.    If SOLICIT is non-nil then the choice of bullet is solicited from
  1956.    user.  Otherwise the distinctiveness of the bullet or the topic
  1957.    depth determines it.
  1958.  
  1959.    Second arg DEPTH forces the topic prefix to that depth, regardless
  1960.    of the topic's current depth.
  1961.  
  1962.    Third arg NUMBER-CONTROL can force the prefix to or away from
  1963.    numbered form.  It has effect only if 'outline-numbered-bullet' is
  1964.    non-nil and soliciting was not explicitly invoked (via first arg).
  1965.    Its effect, numbering or denumbering, then depends on the setting
  1966.    of the forth arg, INDEX.
  1967.  
  1968.    If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the
  1969.    prefix of the topic is forced to be non-numbered.  Null index and
  1970.    non-nil NUMBER-CONTROL forces denumbering.  Non-nil INDEX (and
  1971.    non-nil NUMBER-CONTROL) forces a numbered-prefix form.  If non-nil
  1972.    INDEX is a number, then that number is used for the numbered
  1973.    prefix.  Non-nil and non-number means that the index for the
  1974.    numbered prefix will be derived by outline-make-topic-prefix.
  1975.  
  1976.    Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding
  1977.    siblings.
  1978.  
  1979.    Cf vars 'outline-stylish-prefixes', 'outline-old-style-prefixes',
  1980.    and 'outline-numbered-bullet', which all affect the behavior of
  1981.    this function."
  1982.  
  1983.   (let* ((current-depth (outline-depth))
  1984.          (new-depth (or new-depth current-depth))
  1985.          (mb outline-recent-prefix-beginning)
  1986.          (me outline-recent-prefix-end)
  1987.          (current-bullet (buffer-substring (- me 1) me))
  1988.          (new-prefix (outline-make-topic-prefix current-bullet
  1989.                                                 nil
  1990.                                                 new-depth
  1991.                                                 solicit
  1992.                                                 number-control
  1993.                                                 index)))
  1994.  
  1995.     ;; Don't need to reinsert identical one:
  1996.     (if (and (= current-depth new-depth)
  1997.              (string= current-bullet
  1998.                       (substring new-prefix (1- (length new-prefix)))))
  1999.         t
  2000.  
  2001.       ;; New prefix probably different from old:
  2002.       ;; get rid of old one:
  2003.       (delete-region mb me)
  2004.       (goto-char mb)
  2005.       ;; Dispense with number if numbered-bullet prefix:
  2006.       (if (and outline-numbered-bullet
  2007.                (string= outline-numbered-bullet current-bullet)
  2008.                (looking-at "[0-9]+"))
  2009.           (delete-region (match-beginning 0)(match-end 0)))
  2010.  
  2011.       ;; Put in new prefix:
  2012.       (insert-string new-prefix)
  2013.       )
  2014.  
  2015.     ;; Reindent the body if elected and depth changed:
  2016.     (if (and outline-reindent-bodies
  2017.              (not (= new-depth current-depth)))
  2018.         (outline-reindent-body current-depth new-depth))
  2019.  
  2020.     ;; Recursively rectify successive siblings if selected:
  2021.     (if do-successors
  2022.         (save-excursion
  2023.           (while (outline-next-sibling)
  2024.             (setq index
  2025.                   (cond ((numberp index) (1+ index))
  2026.                         ((not number-control)  (outline-sibling-index))))
  2027.             (if (outline-numbered-type-prefix)
  2028.                 (outline-rebullet-heading nil        ;;; solicit
  2029.                                           new-depth    ;;; new-depth
  2030.                                           number-control;;; number-control
  2031.                                           index        ;;; index
  2032.                                           nil)))))    ;;;(dont!)do-successors
  2033.       )
  2034.   )
  2035. ;;;_     > outline-rebullet-topic (arg)
  2036. (defun outline-rebullet-topic (arg)
  2037.   "   Like outline-rebullet-topic-grunt, but start from topic visible at point.
  2038.    Descends into invisible as well as visible topics, however.
  2039.  
  2040.    With repeat count, shift topic depth by that amount."
  2041.   (interactive "P")
  2042.   (let ((start-col (current-column))
  2043.         (was-eol (eolp)))
  2044.     (save-excursion
  2045.       ;; Normalize arg:
  2046.       (cond ((null arg) (setq arg 0))
  2047.             ((listp arg) (setq arg (car arg))))
  2048.       ;; Fill the user in, in case we're shifting a big topic:
  2049.       (if (not (zerop arg)) (message "Shifting..."))
  2050.       (outline-back-to-current-heading)
  2051.       (if (<= (+ (outline-recent-depth) arg) 0)
  2052.           (error "Attempt to shift topic below level 1"))
  2053.       (outline-rebullet-topic-grunt arg)
  2054.       (if (not (zerop arg)) (message "Shifting... done.")))
  2055.     (move-to-column (max 0 (+ start-col arg))))
  2056.   )
  2057. ;;;_      > outline-rebullet-topic-grunt (&optional relative-depth ...)
  2058. (defun outline-rebullet-topic-grunt (&optional relative-depth
  2059.                                                starting-depth
  2060.                                                starting-point
  2061.                                                index
  2062.                                                do-successors)
  2063.  
  2064.   "   Rebullet the topic at point, visible or invisible, and all
  2065.    contained subtopics.  See outline-rebullet-heading for rebulleting
  2066.    behavior.
  2067.  
  2068.    All arguments are optional.
  2069.  
  2070.    First arg RELATIVE-DEPTH means to shift the depth of the entire
  2071.    topic that amount.
  2072.  
  2073.    The rest of the args are for internal recursive use by the function
  2074.    itself.  The are STARTING-DEPTH, STARTING-POINT, and INDEX."
  2075.  
  2076.   (let* ((relative-depth (or relative-depth 0))
  2077.          (new-depth (outline-depth))
  2078.          (starting-depth (or starting-depth new-depth))
  2079.          (on-starting-call  (null starting-point))
  2080.          (index (or index
  2081.                     ;; Leave index null on starting call, so rebullet-heading
  2082.                     ;; calculates it at what might be new depth:
  2083.                     (and (or (zerop relative-depth)
  2084.                              (not on-starting-call))
  2085.                          (outline-sibling-index))))
  2086.          (moving-outwards (< 0 relative-depth))
  2087.          (starting-point (or starting-point (point))))
  2088.  
  2089.     ;; Sanity check for excessive promotion done only on starting call:
  2090.     (and on-starting-call
  2091.          moving-outwards
  2092.          (> 0 (+ starting-depth relative-depth))
  2093.          (error "Attempt to shift topic out beyond level 1."))    ;;; ====>
  2094.  
  2095.     (cond ((= starting-depth new-depth)
  2096.            ;; We're at depth to work on this one:
  2097.            (outline-rebullet-heading nil        ;;; solicit
  2098.                                      (+ starting-depth    ;;; starting-depth
  2099.                                         relative-depth)
  2100.                                      nil        ;;; number
  2101.                                      index        ;;; index
  2102.                                      ;; Every contained topic will get hit,
  2103.                                      ;; and we have to get to outside ones
  2104.                                      ;; deliberately:
  2105.                                      nil)        ;;; do-successors
  2106.            ;; ... and work on subsequent ones which are at greater depth:
  2107.            (setq index 0)
  2108.            (outline-next-heading)
  2109.            (while (and (not (eobp))
  2110.                        (< starting-depth (outline-recent-depth)))
  2111.              (setq index (1+ index))
  2112.              (outline-rebullet-topic-grunt relative-depth   ;;; relative-depth
  2113.                                            (1+ starting-depth);;;starting-depth
  2114.                                            starting-point   ;;; starting-point
  2115.                                            index)))        ;;; index
  2116.  
  2117.           ((< starting-depth new-depth)
  2118.            ;; Rare case - subtopic more than one level deeper than parent.
  2119.            ;; Treat this one at an even deeper level:
  2120.            (outline-rebullet-topic-grunt relative-depth   ;;; relative-depth
  2121.                                          new-depth      ;;; starting-depth
  2122.                                          starting-point      ;;; starting-point
  2123.                                          index)))      ;;; index
  2124.  
  2125.     (if on-starting-call
  2126.         (progn
  2127.           ;; Rectify numbering of former siblings of the adjusted topic,
  2128.           ;; if topic has changed depth
  2129.           (if (or do-successors
  2130.                   (and (not (zerop relative-depth))
  2131.                        (or (= (outline-recent-depth) starting-depth)
  2132.                            (= (outline-recent-depth) (+ starting-depth
  2133.                                                         relative-depth)))))
  2134.               (outline-rebullet-heading nil nil nil nil t))
  2135.           ;; Now rectify numbering of new siblings of the adjusted topic,
  2136.           ;; if depth has been changed:
  2137.           (progn (goto-char starting-point)
  2138.                  (if (not (zerop relative-depth))
  2139.                      (outline-rebullet-heading nil nil nil nil t)))))
  2140.     )
  2141.   )
  2142. ;;;_     > outline-number-siblings (&optional denumber)
  2143. (defun outline-number-siblings (&optional denumber)
  2144.   "   Assign numbered topic prefix to this topic and its siblings.
  2145.  
  2146.    With universal argument, denumber - assign default bullet to this
  2147.    topic and its siblings.
  2148.  
  2149.    With repeated universal argument (`^U^U'), solicit bullet for each
  2150.    rebulleting each topic at this level."
  2151.  
  2152.   (interactive "P")
  2153.  
  2154.   (save-excursion
  2155.     (outline-back-to-current-heading)
  2156.     (outline-beginning-of-level)
  2157.     (let ((index (if (not denumber) 1))
  2158.           (use-bullet (equal '(16) denumber))
  2159.           (more t))
  2160.       (while more
  2161.         (outline-rebullet-heading use-bullet        ;;; solicit
  2162.                                   nil            ;;; depth
  2163.                                   t            ;;; number-control
  2164.                                   index            ;;; index
  2165.                                   nil)            ;;; do-successors
  2166.         (if index (setq index (1+ index)))
  2167.         (setq more (outline-next-sibling)))
  2168.       )
  2169.     )
  2170.   )
  2171. ;;;_     > outline-shift-in (arg)
  2172. (defun outline-shift-in (arg)
  2173.   "   Decrease prefix depth of current heading and any topics collapsed
  2174.    within it."
  2175.   (interactive "p")
  2176.   (outline-rebullet-topic arg))
  2177. ;;;_     > outline-shift-out (arg)
  2178. (defun outline-shift-out (arg)
  2179.   "   Decrease prefix depth of current heading and any topics collapsed
  2180.    within it."
  2181.   (interactive "p")
  2182.   (outline-rebullet-topic (* arg -1)))
  2183. ;;;_    . Surgery (kill-ring) functions with special provisions for outlines:
  2184. ;;;_     > outline-kill-line (&optional arg)
  2185. (defun outline-kill-line (&optional arg)
  2186.   "   Kill line, adjusting subsequent lines suitably for outline mode."
  2187.  
  2188.   (interactive "*P")
  2189.   (if (not (and
  2190.             (boundp 'outline-mode) outline-mode        ; active outline mode,
  2191.             outline-numbered-bullet        ; numbers may need adjustment,
  2192.             (bolp)                ; may be clipping topic head,
  2193.             (looking-at outline-regexp)))    ; are clipping topic head.
  2194.       ;; Above conditions do not obtain - just do a regular kill:
  2195.       (kill-line arg)
  2196.     ;; Ah, have to watch out for adjustments:
  2197.     (let* ((depth (outline-depth))
  2198.            (ascender depth))
  2199.       (kill-line arg)
  2200.       (sit-for 0)
  2201.       (save-excursion
  2202.         (if (not (looking-at outline-regexp))
  2203.             (outline-next-heading))
  2204.         (if (> (outline-depth) depth)
  2205.             ;; An intervening parent was removed from after a subtree:
  2206.             (setq depth (outline-recent-depth)))
  2207.         (while (and (> (outline-depth) 0)
  2208.                     (> (outline-recent-depth) ascender)
  2209.                     (outline-ascend-to-depth (setq ascender
  2210.                                                    (1- ascender)))))
  2211.         ;; Have to try going forward until we find another at
  2212.         ;; desired depth:
  2213.         (if (and outline-numbered-bullet
  2214.                  (outline-descend-to-depth depth))
  2215.             (outline-rebullet-heading nil        ;;; solicit
  2216.                                       depth        ;;; depth
  2217.                                       nil         ;;; number-control
  2218.                                       nil        ;;; index
  2219.                                       t)        ;;; do-successors
  2220.           )
  2221.         )
  2222.       )
  2223.     )
  2224.   )
  2225. ;;;_     > outline-kill-topic ()
  2226. (defun outline-kill-topic ()
  2227.   "   Kill topic together with subtopics."
  2228.  
  2229.   ;; Some finagling is done to make complex topic kills appear faster
  2230.   ;; than they actually are.  A redisplay is performed immediately
  2231.   ;; after the region is disposed of, though the renumbering process
  2232.   ;; has yet to be performed.  This means that there may appear to be
  2233.   ;; a lag *after* the kill has been performed.
  2234.  
  2235.   (interactive)
  2236.   (let* ((beg (outline-back-to-current-heading))
  2237.          (depth (outline-recent-depth)))
  2238.     (outline-end-of-current-subtree)
  2239.     (if (not (eobp))
  2240.         (forward-char 1))
  2241.     (kill-region beg (point))
  2242.     (sit-for 0)
  2243.     (save-excursion
  2244.       (if (and outline-numbered-bullet
  2245.                (outline-descend-to-depth depth))
  2246.           (outline-rebullet-heading nil        ;;; solicit
  2247.                                     depth    ;;; depth
  2248.                                     nil        ;;; number-control
  2249.                                     nil        ;;; index
  2250.                                     t)        ;;; do-successors
  2251.         )
  2252.       )
  2253.     )
  2254.   )
  2255. ;;;_     > outline-yank (&optional arg)
  2256. (defun outline-yank (&optional arg)
  2257.   "   Like regular yank, except does depth adjustment of yanked topics, when:
  2258.  
  2259.    1 the stuff being yanked starts with a valid outline header prefix, and
  2260.    2 it is being yanked at the end of a line which consists of only a valid
  2261.      topic prefix.
  2262.  
  2263.    If these two conditions hold then the depth of the yanked topics
  2264.    are all adjusted the amount it takes to make the first one at the
  2265.    depth of the header into which it's being yanked.
  2266.  
  2267.    The point is left in from of yanked, adjusted topics, rather than
  2268.    at the end (and vice-versa with the mark).  Non-adjusted yanks,
  2269.    however, (ones that don't qualify for adjustment) are handled
  2270.    exactly like normal yanks.
  2271.  
  2272.    Outline-yank-pop is used with outline-yank just as normal yank-pop
  2273.    is used with normal yank in non-outline buffers."
  2274.  
  2275.   (interactive "*P")
  2276.   (setq this-command 'yank)
  2277.   (if (not (and (boundp 'outline-mode) outline-mode))
  2278.  
  2279.       ;; Outline irrelevant - just do regular yank:
  2280.       (yank arg)
  2281.  
  2282.     ;; Outline *is* relevant:
  2283.     (let ((beginning (point))
  2284.           topic-yanked
  2285.           established-depth)   ; Depth of the prefix into which we're yanking.
  2286.       ;; Get current depth and numbering ... Oops, not doing anything
  2287.       ;; with the number just yet...
  2288.       (if (and (eolp)
  2289.                (save-excursion (beginning-of-line)
  2290.                                (looking-at outline-regexp)))
  2291.           (setq established-depth (- (match-end 0) (match-beginning 0))))
  2292.       (yank arg)
  2293.       (exchange-dot-and-mark)
  2294.       (if (and established-depth        ; the established stuff qualifies.
  2295.                ;; The yanked stuff also qualifies - is topic(s):
  2296.                (looking-at (concat "\\(" outline-regexp "\\)")))
  2297.           ;; Ok, adjust the depth of the yanked stuff.  Note that the
  2298.           ;; stuff may have more than a single root, so we have to
  2299.           ;; iterate over all the top level ones yanked, and do them in
  2300.           ;; such a way that the adjustment of one new one won't affect
  2301.           ;; any of the other new ones.  We use the focus of the
  2302.           ;; narrowed region to successively exclude processed siblings.
  2303.           (let* ((yanked-beg (match-beginning 1))
  2304.                  (yanked-end (match-end 1))
  2305.                  (yanked-bullet (buffer-substring (1- yanked-end) yanked-end))
  2306.                  (yanked-depth (- yanked-end yanked-beg))
  2307.                  (depth-diff (- established-depth yanked-depth))
  2308.                  done
  2309.                  (more t))
  2310.             (setq topic-yanked t)
  2311.             (save-excursion
  2312.               (save-restriction
  2313.                 (narrow-to-region yanked-beg (mark))
  2314.                 ;; First trim off excessive blank line at end, if any:
  2315.                 (goto-char (point-max))
  2316.                 (if (looking-at "^$") (delete-char -1))
  2317.                 (goto-char (point-min))
  2318.                 ;; Work backwards, with each shallowest level,
  2319.                 ;; successively excluding the last processed topic
  2320.                 ;; from the narrow region:
  2321.                 (goto-char (point-max))
  2322.                 (while more
  2323.                   (outline-back-to-current-heading)
  2324.                   ;; go as high as we can in each bunch:
  2325.                   (while (outline-ascend-to-depth
  2326.                           (1- (outline-depth))))
  2327.                   (save-excursion
  2328.                     (outline-rebullet-topic-grunt depth-diff
  2329.                                                   (outline-depth)
  2330.                                                   (point)))
  2331.                   (if (setq more (not (bobp)))
  2332.                       (progn (widen)
  2333.                              (forward-char -1)
  2334.                              (narrow-to-region yanked-beg (point)))))))
  2335.             ;; Preserve new bullet if it's a distinctive one, otherwise
  2336.             ;; use old one:
  2337.             (if (string-match yanked-bullet outline-distinctive-bullets-string)
  2338.                 (delete-region (save-excursion
  2339.                                  (beginning-of-line)
  2340.                                  (point))
  2341.                                yanked-beg)
  2342.               (delete-region yanked-beg (+ yanked-beg established-depth))
  2343.               ;; and extraneous digits and a space:
  2344.               (while (looking-at "[0-9]") (delete-char 1))
  2345.               (if (looking-at " ") (delete-char 1))
  2346.               )
  2347.             (goto-char yanked-beg)
  2348.             )
  2349.         ;; Not established-depth or looking-at...
  2350.         (setq topic-yanked (looking-at outline-regexp))
  2351.         (exchange-dot-and-mark))
  2352.       (if (and topic-yanked outline-numbered-bullet)
  2353.           (progn
  2354.             ;; Renumber, in case necessary:
  2355.             (sit-for 0)
  2356.             (save-excursion
  2357.               (goto-char beginning)
  2358.               (if (outline-goto-prefix)
  2359.                   (outline-rebullet-heading nil        ;;; solicit
  2360.                                             (outline-depth) ;;; depth
  2361.                                             nil        ;;; number-control
  2362.                                             nil        ;;; index
  2363.                                             t)        ;;; do-successors
  2364.                 )
  2365.               )
  2366.             )
  2367.         )
  2368.       )
  2369.     )
  2370.   )
  2371. ;;;_     > outline-yank-pop (&optional arg)
  2372. (defun outline-yank-pop (&optional arg)
  2373.   "   Just like yank-pop, but works like outline-yank when popping
  2374.   topics just after fresh outline prefixes.  Adapts level of popped
  2375.   stuff to level of fresh prefix."
  2376.  
  2377.   (interactive "*p")
  2378.   (if (not (eq last-command 'yank))
  2379.       (error "Previous command was not a yank"))
  2380.   (setq this-command 'yank)
  2381.   (delete-region (point) (mark))
  2382.   (rotate-yank-pointer arg)
  2383.   (outline-yank)
  2384.   )
  2385.  
  2386. ;;;_   : Specialty bullet functions
  2387. ;;;_    . File Cross references
  2388. ;;;_     > outline-resolve-xref ()
  2389. (defun outline-resolve-xref ()
  2390.   "  Pop to file associated with current heading, if it has an xref bullet
  2391.   (according to setting of 'outline-file-xref-bullet')."
  2392.   (interactive)
  2393.   (if (not outline-file-xref-bullet)
  2394.       (error
  2395.        "outline cross references disabled - no 'outline-file-xref-bullet'")
  2396.     (if (not (string= (outline-current-bullet) outline-file-xref-bullet))
  2397.         (error "current heading lacks cross-reference bullet '%s'"
  2398.                outline-file-xref-bullet)
  2399.       (let (file-name)
  2400.         (save-excursion
  2401.           (let* ((text-start outline-recent-prefix-end)
  2402.                  (heading-end (progn (outline-pre-next-preface)
  2403.                                      (point))))
  2404.             (goto-char text-start)
  2405.             (setq file-name
  2406.                   (if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t)
  2407.                       (buffer-substring (match-beginning 1) (match-end 1))))))
  2408.         (setq file-name
  2409.               (if (not (= (aref file-name 0) ?:))
  2410.                   (expand-file-name file-name)
  2411.                                         ; A registry-files ref, strip the ':'
  2412.                                         ; and try to follow it:
  2413.                 (let ((reg-ref (reference-registered-file
  2414.                                 (substring file-name 1) nil t)))
  2415.                   (if reg-ref (car (cdr reg-ref))))))
  2416.         (if (or (file-exists-p file-name)
  2417.                 (if (file-writable-p file-name)
  2418.                     (y-or-n-p (format "%s not there, create one? "
  2419.                                       file-name))
  2420.                   (error "%s not found and can't be created" file-name)))
  2421.             (condition-case failure
  2422.                 (find-file-other-window file-name)
  2423.               (error failure))
  2424.           (error "%s not found" file-name))
  2425.         )
  2426.       )
  2427.     )
  2428.   )
  2429. ;;;_     > outline-to-entry-end - Unmaintained compatibility - ignore this!
  2430. ;-------------------------------------------------------------------
  2431. ; Something added solely for use by a "smart menu" package someone got
  2432. ; off the net.  I have no idea whether this is appropriate code.
  2433.  
  2434. (defvar next-entry-exists nil "Used by outline-to-entry-end, dunno why.")
  2435. (defun outline-to-entry-end (&optional include-sub-entries curr-entry-level)
  2436.   "   Go to end of whole entry if optional INCLUDE-SUB-ENTRIES is non-nil.
  2437.    CURR-ENTRY-LEVEL is an integer representing the length of the current level
  2438.    string which matched to 'outline-regexp'.  If INCLUDE-SUB-ENTRIES is nil,
  2439.    CURR-ENTRY-LEVEL is not needed."
  2440.   (while (and (setq next-entry-exists
  2441.             (re-search-forward outline-regexp nil t))
  2442.           include-sub-entries
  2443.           (save-excursion
  2444.         (beginning-of-line)
  2445.         (> (outline-depth) curr-entry-level))))
  2446.   (if next-entry-exists
  2447.       (progn (beginning-of-line) (point))
  2448.     (goto-char (point-max))))
  2449. ;;; Outline topic prefix and level adjustment funcs:
  2450.  
  2451. ;;;_  #6 miscellaneous
  2452. ;;;_   > outline-copy-exposed (&optional workbuf)
  2453. (defun outline-copy-exposed (&optional workbuf)
  2454.   "   Duplicate buffer to other buffer, sans hidden stuff.
  2455.  
  2456.    Without repeat count, this simple-minded function just generates
  2457.    the new buffer by concatenating the current buffer name with \"
  2458.    exposed\", and doing a 'get-buffer' on it."
  2459.  
  2460.   (interactive)
  2461.   (if (not workbuf) (setq workbuf (concat (buffer-name) " exposed")))
  2462.   (let ((buf (current-buffer)))
  2463.     (if (not (get-buffer workbuf))
  2464.     (generate-new-buffer workbuf))
  2465.     (pop-to-buffer workbuf)
  2466.     (erase-buffer)
  2467.     (insert-buffer buf)
  2468.     (replace-regexp "\^M[^\^M\^J]*" "")
  2469.     (goto-char (point-min))
  2470.     )
  2471.   )
  2472. ;;;_   > outlinify-sticky ()
  2473. (defun outlinify-sticky (&optional arg)
  2474.   "   Activate outline mode and establish file eval to set initial exposure.
  2475.   
  2476.   Invoke with a string argument to designate a string to prepend to
  2477.   topic prefixs, or with a universal argument to be prompted for the
  2478.   string to be used.  Suitable defaults are provided for lisp,
  2479.   emacs-lisp, c, c++, awk, sh, csh, and perl modes."
  2480.  
  2481.  (interactive "P") (outline-mode t)
  2482.  (cond (arg
  2483.         (if (stringp arg)
  2484.             ;; Use arg as the header-prefix:
  2485.             (outline-lead-with-comment-string arg)
  2486.           ;; Otherwise, let function solicit string:
  2487.           (setq arg (outline-lead-with-comment-string))))
  2488.        ((member major-mode '(emacs-lisp-mode lisp-mode))
  2489.         (setq arg (outline-lead-with-comment-string ";;;_")))
  2490.        ((member major-mode '(awk-mode csh-mode sh-mode perl-mode))
  2491.         ;; Bare '#' (ie, not '#_') so we don't break the magic number:
  2492.         (setq arg (outline-lead-with-comment-string "#")))
  2493.        ((eq major-mode 'c++-mode)
  2494.         (setq arg (outline-lead-with-comment-string "//_")))
  2495.        ((eq major-mode 'c-mode)
  2496.         ;; User's will have to know to close off the comments:
  2497.         (setq arg (outline-lead-with-comment-string "/*_"))))
  2498.   (let* ((lead-prefix (format "%s%s"
  2499.                               (concat outline-header-prefix (if arg " " ""))
  2500.                               outline-primary-bullet))
  2501.          (lead-line (format "%s%s %s\n%s %s\n  %s %s %s"
  2502.                             (if arg outline-header-prefix "")
  2503.                             outline-primary-bullet
  2504.                             "Local emacs vars."
  2505.                             "'(This topic sets initial outline exposure"
  2506.                             "of the file when loaded by emacs,"
  2507.                             "Encapsulate it in comments if"
  2508.                             "file is a program"
  2509.                             "otherwise ignore it,")))
  2510.  
  2511.     (save-excursion
  2512.                                         ; Put a topic at the top, if
  2513.                                         ; none there already:
  2514.       (goto-char (point-min))
  2515.       (if (not (looking-at outline-regexp))
  2516.           (insert-string
  2517.            (if (not arg) outline-primary-bullet
  2518.              (format "%s%s\n" outline-header-prefix outline-primary-bullet))))
  2519.                                
  2520.                                         ; File-vars stuff, at the bottom:
  2521.       (goto-char (point-max))
  2522.                                         ; Insert preamble:
  2523.       (insert-string (format "\n\n%s\n%s %s %s\n%s %s "
  2524.                              lead-line
  2525.                              lead-prefix
  2526.                              "local"
  2527.                              "variables:"
  2528.                              lead-prefix
  2529.                              "eval:"))
  2530.                                         ; Insert outline-mode activation:
  2531.       (insert-string
  2532.        (format "%s\n\t\t%s\n\t\t\t%s\n"
  2533.                "(condition-case err"
  2534.                "(save-excursion"
  2535.                "(outline-mode t)"))
  2536.                                         ; Conditionally insert prefix
  2537.                                         ; leader customization:
  2538.       (if arg (insert-string (format "\t\t\t(%s \"%s\")\n"
  2539.                                      "outline-lead-with-comment-string"
  2540.                                      arg)))
  2541.                                         ; Insert announcement and
  2542.                                         ; exposure control:
  2543.       (insert-string
  2544.        (format "\t\t\t%s %s\n\t\t\t%s %s\n\t\t%s %s"
  2545.                "(message \"Adjusting '%s' visibility\""
  2546.                "(buffer-name))"
  2547.                "(goto-char 0)"
  2548.                "(outline-exposure -1 0))"
  2549.                "(error (message "
  2550.                "\"Failed file var 'allout' provisions\")))"))
  2551.                                         ; Insert postamble:
  2552.       (insert-string (format "\n%s End: )\n"
  2553.                              lead-prefix)))))
  2554. ;;;_   > solicit-char-in-string (prompt string &optional do-defaulting)
  2555. (defun solicit-char-in-string (prompt string &optional do-defaulting)
  2556.   "   Solicit (with first arg PROMPT) choice of a character from string STRING.
  2557.  
  2558.    Optional arg DO-DEFAULTING indicates to accept empty input (CR)."
  2559.  
  2560.   (let ((new-prompt prompt)
  2561.         got)
  2562.  
  2563.     (while (not got)
  2564.       (message "%s" new-prompt)
  2565.  
  2566.       ;; We do our own reading here, so we can circumvent, eg, special
  2567.       ;; treatment for '?' character.  (Might oughta change minibuffer
  2568.       ;; keymap instead, oh well.)
  2569.       (setq got
  2570.             (char-to-string (let ((cursor-in-echo-area t)) (read-char))))
  2571.  
  2572.       (if (null (string-match got string))
  2573.           (if (and do-defaulting (string= got "\^M"))
  2574.               ;; We're defaulting, return null string to indicate that:
  2575.               (setq got "")
  2576.             ;; Failed match and not defaulting,
  2577.             ;; set the prompt to give feedback,
  2578.             (setq new-prompt (concat prompt
  2579.                                      got
  2580.                                      " ...pick from: "
  2581.                                      string
  2582.                                      ""))
  2583.             ;; and set loop to try again:
  2584.             (setq got nil))
  2585.         ;; Got a match - give feedback:
  2586.         (message "")))
  2587.     ;; got something out of loop - return it:
  2588.     got)
  2589.   )
  2590. ;;;_   > string-sans-char (string char)
  2591. (defun string-sans-char (string char)
  2592.   "  Return a copy of STRING that lacks all instances of CHAR."
  2593.   (cond ((string= string "") "")
  2594.         ((= (aref string 0) char) (string-sans-char (substring string 1) char))
  2595.         ((concat (substring string 0 1)
  2596.                  (string-sans-char (substring string 1) char)))))
  2597.  
  2598. ;;;_* Local emacs vars.
  2599. '(
  2600. Local variables:
  2601. eval: (save-excursion
  2602.         (if (not (condition-case err (outline-mode t)
  2603.                    (wrong-number-of-arguments nil)))
  2604.             (progn
  2605.               (message
  2606.                "Allout outline-mode not loaded, not adjusting buffer exposure")
  2607.               (sit-for 1))
  2608.           (message "Adjusting '%s' visibility" (buffer-name))
  2609.           (outline-lead-with-comment-string ";;;_")
  2610.           (goto-char 0)
  2611.           (outline-exposure (-1 () () () 1) 0)))
  2612. End:
  2613. )
  2614.  
  2615.